module Data.Prune.Apply where
import Prelude
import Data.Foldable (traverse_)
import Data.Monoid (Endo(Endo), appEndo)
import Data.Set (Set)
import Data.Text (pack, unpack)
import Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription)
import qualified Data.Set as Set
import Data.Prune.ApplyStrategy.Safe (stripGenericPackageDescription)
import Data.Prune.ApplyStrategy.Smart (stripSections)
import Data.Prune.Confirm (confirm)
import Data.Prune.Section.Parser (writeCabalSections)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
import qualified Data.Prune.Confirm as Confirm
import qualified Data.Prune.Section.Types as T
import qualified Data.Prune.Types as T
data Apply (a :: T.ApplyStrategy) where
ApplySafe :: FilePath -> GenericPackageDescription -> Endo GenericPackageDescription -> Apply 'T.ApplyStrategySafe
ApplySmart :: FilePath -> [T.Section] -> Endo [T.Section] -> Apply 'T.ApplyStrategySmart
data SomeApply = forall (a :: T.ApplyStrategy). SomeApply { ()
unSomeApply :: Apply a }
runApply :: SomeApply -> T.Package -> Set T.DependencyName -> Maybe T.Compilable -> T.ShouldApply -> IO (Bool, SomeApply)
runApply :: SomeApply
-> Package
-> Set DependencyName
-> Maybe Compilable
-> ShouldApply
-> IO (Bool, SomeApply)
runApply (SomeApply Apply a
ap) T.Package {FilePath
[Compilable]
GenericPackageDescription
Set DependencyName
Text
packageCompilables :: Package -> [Compilable]
packageBaseDependencies :: Package -> Set DependencyName
packageDescription :: Package -> GenericPackageDescription
packageFile :: Package -> FilePath
packageName :: Package -> Text
packageCompilables :: [Compilable]
packageBaseDependencies :: Set DependencyName
packageDescription :: GenericPackageDescription
packageFile :: FilePath
packageName :: Text
..} Set DependencyName
dependencies Maybe Compilable
compilableMay = \case
ShouldApply
T.ShouldNotApply -> do
IO ()
printDependencies
(Bool, SomeApply) -> IO (Bool, SomeApply)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, SomeApply
applyNoop)
ShouldApply
T.ShouldApply -> do
IO ()
printDependencies
FilePath -> IO Bool
confirm FilePath
"Apply these changes? (Y/n)" IO Bool -> (Bool -> IO (Bool, SomeApply)) -> IO (Bool, SomeApply)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> (Bool, SomeApply) -> IO (Bool, SomeApply)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, SomeApply
applyNoop)
Bool
True -> (Bool, SomeApply) -> IO (Bool, SomeApply)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, SomeApply
applyOnce)
ShouldApply
T.ShouldApplyNoVerify -> do
IO ()
printDependencies
(Bool, SomeApply) -> IO (Bool, SomeApply)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, SomeApply
applyOnce)
where
printDependencies :: IO ()
printDependencies = case Maybe Compilable
compilableMay of
Maybe Compilable
Nothing -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (Text -> FilePath) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
Confirm.warn (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Some unused base dependencies for package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageName
(DependencyName -> IO ()) -> [DependencyName] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (DependencyName -> FilePath) -> DependencyName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> FilePath)
-> (DependencyName -> Text) -> DependencyName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (DependencyName -> Text) -> DependencyName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyName -> Text
T.unDependencyName) ([DependencyName] -> IO ()) -> [DependencyName] -> IO ()
forall a b. (a -> b) -> a -> b
$ Set DependencyName -> [DependencyName]
forall a. Set a -> [a]
Set.toList Set DependencyName
dependencies
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
..} -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (Text -> FilePath) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
Confirm.warn (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Some unused dependencies for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack (CompilableType -> FilePath
forall a. Show a => a -> FilePath
show CompilableType
compilableType) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CompilableName -> Text
T.unCompilableName CompilableName
compilableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageName
(DependencyName -> IO ()) -> [DependencyName] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (DependencyName -> FilePath) -> DependencyName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> FilePath)
-> (DependencyName -> Text) -> DependencyName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (DependencyName -> Text) -> DependencyName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyName -> Text
T.unDependencyName) ([DependencyName] -> IO ()) -> [DependencyName] -> IO ()
forall a b. (a -> b) -> a -> b
$ Set DependencyName -> [DependencyName]
forall a. Set a -> [a]
Set.toList Set DependencyName
dependencies
applyNoop :: SomeApply
applyNoop = case Apply a
ap of
ApplySafe FilePath
x GenericPackageDescription
y Endo GenericPackageDescription
z -> Apply 'ApplyStrategySafe -> SomeApply
forall (a :: ApplyStrategy). Apply a -> SomeApply
SomeApply (Apply 'ApplyStrategySafe -> SomeApply)
-> Apply 'ApplyStrategySafe -> SomeApply
forall a b. (a -> b) -> a -> b
$ FilePath
-> GenericPackageDescription
-> Endo GenericPackageDescription
-> Apply 'ApplyStrategySafe
ApplySafe FilePath
x GenericPackageDescription
y Endo GenericPackageDescription
z
ApplySmart FilePath
x [Section]
y Endo [Section]
z -> Apply 'ApplyStrategySmart -> SomeApply
forall (a :: ApplyStrategy). Apply a -> SomeApply
SomeApply (Apply 'ApplyStrategySmart -> SomeApply)
-> Apply 'ApplyStrategySmart -> SomeApply
forall a b. (a -> b) -> a -> b
$ FilePath
-> [Section] -> Endo [Section] -> Apply 'ApplyStrategySmart
ApplySmart FilePath
x [Section]
y Endo [Section]
z
applyOnce :: SomeApply
applyOnce = case Apply a
ap of
ApplySafe FilePath
x GenericPackageDescription
y Endo GenericPackageDescription
z -> Apply 'ApplyStrategySafe -> SomeApply
forall (a :: ApplyStrategy). Apply a -> SomeApply
SomeApply (Apply 'ApplyStrategySafe -> SomeApply)
-> Apply 'ApplyStrategySafe -> SomeApply
forall a b. (a -> b) -> a -> b
$ FilePath
-> GenericPackageDescription
-> Endo GenericPackageDescription
-> Apply 'ApplyStrategySafe
ApplySafe FilePath
x GenericPackageDescription
y (Endo GenericPackageDescription -> Apply 'ApplyStrategySafe)
-> Endo GenericPackageDescription -> Apply 'ApplyStrategySafe
forall a b. (a -> b) -> a -> b
$ Endo GenericPackageDescription
z Endo GenericPackageDescription
-> Endo GenericPackageDescription -> Endo GenericPackageDescription
forall a. Semigroup a => a -> a -> a
<> (GenericPackageDescription -> GenericPackageDescription)
-> Endo GenericPackageDescription
forall a. (a -> a) -> Endo a
Endo (\GenericPackageDescription
w -> GenericPackageDescription
-> Set DependencyName
-> Maybe Compilable
-> GenericPackageDescription
stripGenericPackageDescription GenericPackageDescription
w Set DependencyName
dependencies Maybe Compilable
compilableMay)
ApplySmart FilePath
x [Section]
y Endo [Section]
z -> Apply 'ApplyStrategySmart -> SomeApply
forall (a :: ApplyStrategy). Apply a -> SomeApply
SomeApply (Apply 'ApplyStrategySmart -> SomeApply)
-> Apply 'ApplyStrategySmart -> SomeApply
forall a b. (a -> b) -> a -> b
$ FilePath
-> [Section] -> Endo [Section] -> Apply 'ApplyStrategySmart
ApplySmart FilePath
x [Section]
y (Endo [Section] -> Apply 'ApplyStrategySmart)
-> Endo [Section] -> Apply 'ApplyStrategySmart
forall a b. (a -> b) -> a -> b
$ Endo [Section]
z Endo [Section] -> Endo [Section] -> Endo [Section]
forall a. Semigroup a => a -> a -> a
<> ([Section] -> [Section]) -> Endo [Section]
forall a. (a -> a) -> Endo a
Endo (\[Section]
w -> [Section] -> Set DependencyName -> Maybe Compilable -> [Section]
stripSections [Section]
w Set DependencyName
dependencies Maybe Compilable
compilableMay)
writeApply :: SomeApply -> IO ()
writeApply :: SomeApply -> IO ()
writeApply (SomeApply Apply a
ap) = case Apply a
ap of
ApplySafe FilePath
fp GenericPackageDescription
description Endo GenericPackageDescription
endo -> FilePath -> GenericPackageDescription -> IO ()
writeGenericPackageDescription FilePath
fp (Endo GenericPackageDescription
-> GenericPackageDescription -> GenericPackageDescription
forall a. Endo a -> a -> a
appEndo Endo GenericPackageDescription
endo GenericPackageDescription
description)
ApplySmart FilePath
fp [Section]
parsed Endo [Section]
endo -> FilePath -> [Section] -> IO ()
writeCabalSections FilePath
fp (Endo [Section] -> [Section] -> [Section]
forall a. Endo a -> a -> a
appEndo Endo [Section]
endo [Section]
parsed)