module Data.Prune.ApplyStrategy.Smart where
import Prelude
import Control.Arrow (second)
import Data.Function (fix)
import Data.List (intercalate)
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import Data.Text (pack, splitOn, unpack)
import Text.Regex (Regex, matchRegex, mkRegex)
import qualified Data.Set as Set
import qualified Data.Prune.Section.Types as T
import qualified Data.Prune.Types as T
data StripTarget
= StripTargetBaseLibrary
| StripTargetCompilable T.Compilable
| StripTargetCommonStanza (Set T.CommonName)
dependencyNameRegex :: Regex
dependencyNameRegex :: Regex
dependencyNameRegex = String -> Regex
mkRegex String
"^ *([a-zA-Z0-9\\-]+).*$"
matchDependencyName :: String -> Maybe T.DependencyName
matchDependencyName :: String -> Maybe DependencyName
matchDependencyName String
str = DependencyName -> Maybe DependencyName
forall a. a -> Maybe a
Just (DependencyName -> Maybe DependencyName)
-> (String -> DependencyName) -> String -> Maybe DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DependencyName
T.DependencyName (Text -> DependencyName)
-> (String -> Text) -> String -> DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Maybe DependencyName)
-> Maybe String -> Maybe DependencyName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String] -> Maybe String
forall a. [a] -> Maybe a
T.headMay ([String] -> Maybe String) -> Maybe [String] -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Regex -> String -> Maybe [String]
matchRegex Regex
dependencyNameRegex String
str
stripOneBuildDepends :: String -> Set T.DependencyName -> Maybe String
stripOneBuildDepends :: String -> Set DependencyName -> Maybe String
stripOneBuildDepends String
input Set DependencyName
dependencies =
let output :: String
output = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
go ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack ([Text] -> [String]) -> (String -> [Text]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
input
in case Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
output) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
' ') String
output of
Bool
True -> Maybe String
forall a. Maybe a
Nothing
Bool
False -> String -> Maybe String
forall a. a -> Maybe a
Just String
output
where
go :: String -> Maybe String
go String
x = case String -> Maybe DependencyName
matchDependencyName String
x of
Maybe DependencyName
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just String
x
Just DependencyName
dep -> case DependencyName -> Set DependencyName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member DependencyName
dep Set DependencyName
dependencies of
Bool
True -> Maybe String
forall a. Maybe a
Nothing
Bool
False -> String -> Maybe String
forall a. a -> Maybe a
Just String
x
stripBuildDepends :: [String] -> Set T.DependencyName -> [String]
stripBuildDepends :: [String] -> Set DependencyName -> [String]
stripBuildDepends [String]
buildDepends Set DependencyName
dependencies = (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\String
x -> String -> Set DependencyName -> Maybe String
stripOneBuildDepends String
x Set DependencyName
dependencies) [String]
buildDepends
stripNestedSection :: T.NestedSection -> Set T.DependencyName -> (T.NestedSection, Set T.CommonName)
stripNestedSection :: NestedSection
-> Set DependencyName -> (NestedSection, Set CommonName)
stripNestedSection NestedSection
nested Set DependencyName
dependencies = case NestedSection
nested of
T.BuildDependsNestedSection Int
numSpaces [String]
buildDepends -> (Int -> [String] -> NestedSection
T.BuildDependsNestedSection Int
numSpaces ([String] -> Set DependencyName -> [String]
stripBuildDepends [String]
buildDepends Set DependencyName
dependencies), Set CommonName
forall a. Monoid a => a
mempty)
T.ImportNestedSection Int
numSpaces [String]
imports ->
let common :: Set CommonName
common = [CommonName] -> Set CommonName
forall a. Ord a => [a] -> Set a
Set.fromList ([CommonName] -> Set CommonName) -> [CommonName] -> Set CommonName
forall a b. (a -> b) -> a -> b
$ Text -> CommonName
T.CommonName (Text -> CommonName) -> [Text] -> [CommonName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat ((String -> [Text]) -> [String] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> [Text]
splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (String -> [String]
words ([String] -> String
unwords [String]
imports)))
in (Int -> [String] -> NestedSection
T.ImportNestedSection Int
numSpaces [String]
imports, Set CommonName
common)
NestedSection
other -> (NestedSection
other, Set CommonName
forall a. Monoid a => a
mempty)
stripNestedSections :: [T.NestedSection] -> Set T.DependencyName -> ([T.NestedSection], Set T.CommonName)
stripNestedSections :: [NestedSection]
-> Set DependencyName -> ([NestedSection], Set CommonName)
stripNestedSections [NestedSection]
nested Set DependencyName
dependencies = ([Set CommonName] -> Set CommonName)
-> ([NestedSection], [Set CommonName])
-> ([NestedSection], Set CommonName)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Set CommonName] -> Set CommonName
forall a. Monoid a => [a] -> a
mconcat (([NestedSection], [Set CommonName])
-> ([NestedSection], Set CommonName))
-> ([NestedSection], [Set CommonName])
-> ([NestedSection], Set CommonName)
forall a b. (a -> b) -> a -> b
$ [(NestedSection, Set CommonName)]
-> ([NestedSection], [Set CommonName])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(NestedSection, Set CommonName)]
-> ([NestedSection], [Set CommonName]))
-> [(NestedSection, Set CommonName)]
-> ([NestedSection], [Set CommonName])
forall a b. (a -> b) -> a -> b
$ (NestedSection -> (NestedSection, Set CommonName))
-> [NestedSection] -> [(NestedSection, Set CommonName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NestedSection
x -> NestedSection
-> Set DependencyName -> (NestedSection, Set CommonName)
stripNestedSection NestedSection
x Set DependencyName
dependencies) [NestedSection]
nested
stripSection :: T.Section -> Set T.DependencyName -> StripTarget -> (T.Section, Set T.CommonName)
stripSection :: Section
-> Set DependencyName -> StripTarget -> (Section, Set CommonName)
stripSection Section
section Set DependencyName
dependencies StripTarget
target = case (Section
section, StripTarget
target) of
(T.TargetSection CompilableType
T.CompilableTypeLibrary Maybe CompilableName
Nothing [NestedSection]
nested, StripTarget
StripTargetBaseLibrary) ->
let ([NestedSection]
newNested, Set CommonName
common) = [NestedSection]
-> Set DependencyName -> ([NestedSection], Set CommonName)
stripNestedSections [NestedSection]
nested Set DependencyName
dependencies
in (CompilableType
-> Maybe CompilableName -> [NestedSection] -> Section
T.TargetSection CompilableType
T.CompilableTypeLibrary Maybe CompilableName
forall a. Maybe a
Nothing [NestedSection]
newNested, Set CommonName
common)
(T.TargetSection CompilableType
typ (Just CompilableName
name) [NestedSection]
nested, StripTargetCompilable T.Compilable {Set String
Set DependencyName
CompilableName
CompilableType
compilableFiles :: Compilable -> Set String
compilableDependencies :: Compilable -> Set DependencyName
compilableType :: Compilable -> CompilableType
compilableName :: Compilable -> CompilableName
compilableFiles :: Set String
compilableDependencies :: Set DependencyName
compilableType :: CompilableType
compilableName :: CompilableName
..}) | CompilableType
typ CompilableType -> CompilableType -> Bool
forall a. Eq a => a -> a -> Bool
== CompilableType
compilableType Bool -> Bool -> Bool
&& CompilableName
name CompilableName -> CompilableName -> Bool
forall a. Eq a => a -> a -> Bool
== CompilableName
compilableName ->
let ([NestedSection]
newNested, Set CommonName
common) = [NestedSection]
-> Set DependencyName -> ([NestedSection], Set CommonName)
stripNestedSections [NestedSection]
nested Set DependencyName
dependencies
in (CompilableType
-> Maybe CompilableName -> [NestedSection] -> Section
T.TargetSection CompilableType
typ (CompilableName -> Maybe CompilableName
forall a. a -> Maybe a
Just CompilableName
name) [NestedSection]
newNested, Set CommonName
common)
(T.CommonSection CommonName
name [NestedSection]
nested, StripTargetCommonStanza Set CommonName
common) | CommonName -> Set CommonName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member CommonName
name Set CommonName
common ->
let ([NestedSection]
newNested, Set CommonName
newCommon) = [NestedSection]
-> Set DependencyName -> ([NestedSection], Set CommonName)
stripNestedSections [NestedSection]
nested Set DependencyName
dependencies
in (CommonName -> [NestedSection] -> Section
T.CommonSection CommonName
name [NestedSection]
newNested, Set CommonName
newCommon)
(Section
other, StripTarget
_) -> (Section
other, Set CommonName
forall a. Monoid a => a
mempty)
stripSections :: [T.Section] -> Set T.DependencyName -> Maybe T.Compilable -> [T.Section]
stripSections :: [Section] -> Set DependencyName -> Maybe Compilable -> [Section]
stripSections [Section]
sections Set DependencyName
dependencies Maybe Compilable
compilableMay =
let run :: StripTarget -> [Section] -> ([Section], Set CommonName)
run StripTarget
target = ([Set CommonName] -> Set CommonName)
-> ([Section], [Set CommonName]) -> ([Section], Set CommonName)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Set CommonName] -> Set CommonName
forall a. Monoid a => [a] -> a
mconcat (([Section], [Set CommonName]) -> ([Section], Set CommonName))
-> ([Section] -> ([Section], [Set CommonName]))
-> [Section]
-> ([Section], Set CommonName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Section, Set CommonName)] -> ([Section], [Set CommonName])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Section, Set CommonName)] -> ([Section], [Set CommonName]))
-> ([Section] -> [(Section, Set CommonName)])
-> [Section]
-> ([Section], [Set CommonName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section -> (Section, Set CommonName))
-> [Section] -> [(Section, Set CommonName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Section
x -> Section
-> Set DependencyName -> StripTarget -> (Section, Set CommonName)
stripSection Section
x Set DependencyName
dependencies StripTarget
target)
firstTarget :: StripTarget
firstTarget = StripTarget
-> (Compilable -> StripTarget) -> Maybe Compilable -> StripTarget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StripTarget
StripTargetBaseLibrary Compilable -> StripTarget
StripTargetCompilable Maybe Compilable
compilableMay
firstPass :: ([Section], Set CommonName)
firstPass = StripTarget -> [Section] -> ([Section], Set CommonName)
run StripTarget
firstTarget [Section]
sections
in (((([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName)
-> ((([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section])
-> [Section]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section]
forall a. (a -> a) -> a
fix ([Section], Set CommonName)
firstPass (((([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section])
-> [Section])
-> ((([Section], Set CommonName) -> [Section])
-> ([Section], Set CommonName) -> [Section])
-> [Section]
forall a b. (a -> b) -> a -> b
$ \([Section], Set CommonName) -> [Section]
recur -> \case
([Section]
final, Set CommonName
none) | Set CommonName -> Bool
forall a. Set a -> Bool
Set.null Set CommonName
none -> [Section]
final
([Section]
next, Set CommonName
common) -> ([Section], Set CommonName) -> [Section]
recur (StripTarget -> [Section] -> ([Section], Set CommonName)
run (Set CommonName -> StripTarget
StripTargetCommonStanza Set CommonName
common) [Section]
next)