-- |Description: Apply changes according to the provided 'T.ApplyStrategy'.
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

-- |Continuation GADT for applying changes to a cabal file.
data Apply (a :: T.ApplyStrategy) where
  ApplySafe :: FilePath -> GenericPackageDescription -> Endo GenericPackageDescription -> Apply 'T.ApplyStrategySafe
  ApplySmart :: FilePath -> [T.Section] -> Endo [T.Section] -> Apply 'T.ApplyStrategySmart

-- |Wrap 'Apply' in a data type so that it can be passed to functions without escaping the inner type.
data SomeApply = forall (a :: T.ApplyStrategy). SomeApply { ()
unSomeApply :: Apply a }

-- |Iterate on a cabal file by pruning one target at a time. Return whether the command-line call to @prune-juice@ should fail.
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)

-- |Write the series of changes to the cabal file.
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)