-- |Description: Apply @prune-juice@ to cabal files safely, with the understanding that the file formatting will change.
module Data.Prune.ApplyStrategy.Safe where

import Prelude

import Data.Set (Set)
import Distribution.Types.Benchmark (Benchmark)
import Distribution.Types.BuildInfo (BuildInfo)
import Distribution.Types.CondTree (CondTree)
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.Executable (Executable)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
import Distribution.Types.Library (Library)
import Distribution.Types.TestSuite (TestSuite)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import qualified Data.Set as Set
import qualified Distribution.Types.Benchmark as Benchmark
import qualified Distribution.Types.BuildInfo as BuildInfo
import qualified Distribution.Types.CondTree as CondTree
import qualified Distribution.Types.Executable as Executable
import qualified Distribution.Types.GenericPackageDescription as GenericPackageDescription
import qualified Distribution.Types.Library as Library
import qualified Distribution.Types.TestSuite as TestSuite

import qualified Data.Prune.Types as T

-- |Filter out dependencies.
stripDependencies :: Set T.DependencyName -> [Dependency] -> [Dependency]
stripDependencies :: Set DependencyName -> [Dependency] -> [Dependency]
stripDependencies Set DependencyName
dependencies = (Dependency -> [Dependency] -> [Dependency])
-> [Dependency] -> [Dependency] -> [Dependency]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Dependency -> [Dependency] -> [Dependency]
go [Dependency]
forall a. Monoid a => a
mempty
  where
    go :: Dependency -> [Dependency] -> [Dependency]
go Dependency
next [Dependency]
accum = case DependencyName -> Set DependencyName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Dependency -> DependencyName
T.mkDependencyName Dependency
next) Set DependencyName
dependencies of
      Bool
True -> [Dependency]
accum
      Bool
False -> Dependency
nextDependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
:[Dependency]
accum

-- |Strip dependencies from a single target.
stripBuildInfo :: Set T.DependencyName -> BuildInfo -> BuildInfo
stripBuildInfo :: Set DependencyName -> BuildInfo -> BuildInfo
stripBuildInfo Set DependencyName
dependencies BuildInfo
buildInfo = BuildInfo
buildInfo
  { targetBuildDepends :: [Dependency]
BuildInfo.targetBuildDepends = Set DependencyName -> [Dependency] -> [Dependency]
stripDependencies Set DependencyName
dependencies (BuildInfo -> [Dependency]
BuildInfo.targetBuildDepends BuildInfo
buildInfo)
  }

-- |Strip dependencies from a library.
stripLibrary :: Set T.DependencyName -> Library -> Library
stripLibrary :: Set DependencyName -> Library -> Library
stripLibrary Set DependencyName
dependencies Library
lib = Library
lib
  { libBuildInfo :: BuildInfo
Library.libBuildInfo = Set DependencyName -> BuildInfo -> BuildInfo
stripBuildInfo Set DependencyName
dependencies (Library -> BuildInfo
Library.libBuildInfo Library
lib)
  }

-- |Strip dependencies from an executable.
stripExecutable :: Set T.DependencyName -> Executable -> Executable
stripExecutable :: Set DependencyName -> Executable -> Executable
stripExecutable Set DependencyName
dependencies Executable
exe = Executable
exe
  { buildInfo :: BuildInfo
Executable.buildInfo = Set DependencyName -> BuildInfo -> BuildInfo
stripBuildInfo Set DependencyName
dependencies (Executable -> BuildInfo
Executable.buildInfo Executable
exe)
  }

-- |Strip dependencies from a test suite.
stripTestSuite :: Set T.DependencyName -> TestSuite -> TestSuite
stripTestSuite :: Set DependencyName -> TestSuite -> TestSuite
stripTestSuite Set DependencyName
dependencies TestSuite
test = TestSuite
test
  { testBuildInfo :: BuildInfo
TestSuite.testBuildInfo = Set DependencyName -> BuildInfo -> BuildInfo
stripBuildInfo Set DependencyName
dependencies (TestSuite -> BuildInfo
TestSuite.testBuildInfo TestSuite
test)
  }

-- |Strip dependencies from a benchmark.
stripBenchmark :: Set T.DependencyName -> Benchmark -> Benchmark
stripBenchmark :: Set DependencyName -> Benchmark -> Benchmark
stripBenchmark Set DependencyName
dependencies Benchmark
bench = Benchmark
bench
  { benchmarkBuildInfo :: BuildInfo
Benchmark.benchmarkBuildInfo = Set DependencyName -> BuildInfo -> BuildInfo
stripBuildInfo Set DependencyName
dependencies (Benchmark -> BuildInfo
Benchmark.benchmarkBuildInfo Benchmark
bench)
  }

-- |Strip dependencies from a single target.
stripCondTree :: (b -> b) -> CondTree a [Dependency] b -> CondTree a [Dependency] b
stripCondTree :: (b -> b) -> CondTree a [Dependency] b -> CondTree a [Dependency] b
stripCondTree b -> b
f CondTree a [Dependency] b
condTree = CondTree a [Dependency] b
condTree
  { condTreeData :: b
CondTree.condTreeData = b -> b
f (CondTree a [Dependency] b -> b
forall v c a. CondTree v c a -> a
CondTree.condTreeData CondTree a [Dependency] b
condTree)
  }

-- |Strip dependencies from multiple targets.
stripCondTrees :: (b -> b) -> T.CompilableName -> [(UnqualComponentName, CondTree a [Dependency] b)] -> [(UnqualComponentName, CondTree a [Dependency] b)]
stripCondTrees :: (b -> b)
-> CompilableName
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
stripCondTrees b -> b
f CompilableName
compilableName = ((UnqualComponentName, CondTree a [Dependency] b)
 -> [(UnqualComponentName, CondTree a [Dependency] b)]
 -> [(UnqualComponentName, CondTree a [Dependency] b)])
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (UnqualComponentName, CondTree a [Dependency] b)
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
go [(UnqualComponentName, CondTree a [Dependency] b)]
forall a. Monoid a => a
mempty
  where
    go :: (UnqualComponentName, CondTree a [Dependency] b)
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
go (UnqualComponentName, CondTree a [Dependency] b)
next [(UnqualComponentName, CondTree a [Dependency] b)]
accum = case CompilableName
compilableName CompilableName -> CompilableName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> CompilableName
T.mkCompilableName ((UnqualComponentName, CondTree a [Dependency] b)
-> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, CondTree a [Dependency] b)
next) of
      Bool
True -> ((UnqualComponentName, CondTree a [Dependency] b)
-> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, CondTree a [Dependency] b)
next, (b -> b) -> CondTree a [Dependency] b -> CondTree a [Dependency] b
forall b a.
(b -> b) -> CondTree a [Dependency] b -> CondTree a [Dependency] b
stripCondTree b -> b
f ((UnqualComponentName, CondTree a [Dependency] b)
-> CondTree a [Dependency] b
forall a b. (a, b) -> b
snd (UnqualComponentName, CondTree a [Dependency] b)
next))(UnqualComponentName, CondTree a [Dependency] b)
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
forall a. a -> [a] -> [a]
:[(UnqualComponentName, CondTree a [Dependency] b)]
accum
      Bool
False -> (UnqualComponentName, CondTree a [Dependency] b)
next(UnqualComponentName, CondTree a [Dependency] b)
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
forall a. a -> [a] -> [a]
:[(UnqualComponentName, CondTree a [Dependency] b)]
accum

-- |Strip dependencies from a package.
stripGenericPackageDescription :: GenericPackageDescription -> Set T.DependencyName -> Maybe T.Compilable -> GenericPackageDescription
stripGenericPackageDescription :: GenericPackageDescription
-> Set DependencyName
-> Maybe Compilable
-> GenericPackageDescription
stripGenericPackageDescription GenericPackageDescription
genericPackageDescription Set DependencyName
dependencies = \case
  Maybe Compilable
Nothing -> case GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary GenericPackageDescription
genericPackageDescription of
    Maybe (CondTree ConfVar [Dependency] Library)
Nothing -> GenericPackageDescription
genericPackageDescription
    Just CondTree ConfVar [Dependency] Library
lib -> GenericPackageDescription
genericPackageDescription
      { condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary = CondTree ConfVar [Dependency] Library
-> Maybe (CondTree ConfVar [Dependency] Library)
forall a. a -> Maybe a
Just ((Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> CondTree ConfVar [Dependency] Library
forall b a.
(b -> b) -> CondTree a [Dependency] b -> CondTree a [Dependency] b
stripCondTree (Set DependencyName -> Library -> Library
stripLibrary Set DependencyName
dependencies) CondTree ConfVar [Dependency] Library
lib)
      }
  Just T.Compilable {Set FilePath
Set DependencyName
CompilableName
CompilableType
compilableFiles :: Compilable -> Set FilePath
compilableDependencies :: Compilable -> Set DependencyName
compilableType :: Compilable -> CompilableType
compilableName :: Compilable -> CompilableName
compilableFiles :: Set FilePath
compilableDependencies :: Set DependencyName
compilableType :: CompilableType
compilableName :: CompilableName
..} -> case CompilableType
compilableType of
    CompilableType
T.CompilableTypeLibrary -> GenericPackageDescription
genericPackageDescription
      { condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries = (Library -> Library)
-> CompilableName
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall b a.
(b -> b)
-> CompilableName
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
stripCondTrees (Set DependencyName -> Library -> Library
stripLibrary Set DependencyName
dependencies) CompilableName
compilableName (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries GenericPackageDescription
genericPackageDescription)
      }
    CompilableType
T.CompilableTypeExecutable -> GenericPackageDescription
genericPackageDescription
      { condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables = (Executable -> Executable)
-> CompilableName
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
forall b a.
(b -> b)
-> CompilableName
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
stripCondTrees (Set DependencyName -> Executable -> Executable
stripExecutable Set DependencyName
dependencies) CompilableName
compilableName (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables GenericPackageDescription
genericPackageDescription)
      }
    CompilableType
T.CompilableTypeTest -> GenericPackageDescription
genericPackageDescription
      { condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites = (TestSuite -> TestSuite)
-> CompilableName
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall b a.
(b -> b)
-> CompilableName
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
stripCondTrees (Set DependencyName -> TestSuite -> TestSuite
stripTestSuite Set DependencyName
dependencies) CompilableName
compilableName (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites GenericPackageDescription
genericPackageDescription)
      }
    CompilableType
T.CompilableTypeBenchmark -> GenericPackageDescription
genericPackageDescription
      { condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks = (Benchmark -> Benchmark)
-> CompilableName
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall b a.
(b -> b)
-> CompilableName
-> [(UnqualComponentName, CondTree a [Dependency] b)]
-> [(UnqualComponentName, CondTree a [Dependency] b)]
stripCondTrees (Set DependencyName -> Benchmark -> Benchmark
stripBenchmark Set DependencyName
dependencies) CompilableName
compilableName (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks GenericPackageDescription
genericPackageDescription)
      }