{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Distribution.Uusi.Core
( uusiGenericPackageDescription,
allToAnyVersion,
removeByName,
overwriteByName,
replaceByName,
buildableByName,
optionsByName,
addOptionsForAll,
removeOptionsForAll,
)
where
import Data.List ((\\))
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import Distribution.Compiler (PerCompilerFlavor (..))
import Distribution.Types.CondTree (CondTree, mapTreeConstrs, mapTreeData)
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.Lens
import Distribution.Types.PackageName (PackageName, unPackageName)
import Distribution.Types.UnqualComponentName
import Distribution.Types.VersionRange (VersionRange, anyVersion)
import Distribution.Uusi.Types
import Distribution.Uusi.Utils
import Distribution.Uusi.Lens
allToAnyVersion :: Uusi
allToAnyVersion :: Uusi
allToAnyVersion = forall tag.
tag -> (PackageName -> Bool) -> VersionRange -> Action tag
SetVersion Text
"All dependencies" (forall a b. a -> b -> a
const Bool
True) VersionRange
anyVersion
removeByName :: PackageName -> Uusi
removeByName :: PackageName -> Uusi
removeByName PackageName
name = forall tag. tag -> (PackageName -> Bool) -> Action tag
Remove (PackageName -> String
unPackageName PackageName
name forall a b. a -> (a -> b) -> b
|> String -> Text
T.pack) (forall a. Eq a => a -> a -> Bool
== PackageName
name)
overwriteByName :: PackageName -> VersionRange -> Uusi
overwriteByName :: PackageName -> VersionRange -> Uusi
overwriteByName PackageName
name = forall tag.
tag -> (PackageName -> Bool) -> VersionRange -> Action tag
SetVersion (PackageName -> String
unPackageName PackageName
name forall a b. a -> (a -> b) -> b
|> String -> Text
T.pack) (forall a. Eq a => a -> a -> Bool
== PackageName
name)
replaceByName :: PackageName -> [(PackageName, VersionRange)] -> Uusi
replaceByName :: PackageName -> [(PackageName, VersionRange)] -> Uusi
replaceByName PackageName
name [(PackageName, VersionRange)]
t = forall tag.
tag -> (PackageName -> Bool) -> [VersionedPackage] -> Action tag
Replace (PackageName -> String
unPackageName PackageName
name forall a b. a -> (a -> b) -> b
|> String -> Text
T.pack) (forall a. Eq a => a -> a -> Bool
== PackageName
name) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PackageName -> VersionRange -> VersionedPackage
VersionedPackage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PackageName, VersionRange)]
t)
buildableByName :: UnqualComponentName -> Bool -> Uusi
buildableByName :: UnqualComponentName -> Bool -> Uusi
buildableByName UnqualComponentName
name = forall tag.
tag -> (UnqualComponentName -> Bool) -> Bool -> Action tag
SetBuildable (UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name forall a b. a -> (a -> b) -> b
|> String -> Text
T.pack) (forall a. Eq a => a -> a -> Bool
== UnqualComponentName
name)
optionsByName :: UnqualComponentName -> Op [String] -> Uusi
optionsByName :: UnqualComponentName -> Op [String] -> Uusi
optionsByName UnqualComponentName
name = forall tag.
tag -> (UnqualComponentName -> Bool) -> Op [String] -> Action tag
ModifyBuiltOptions (UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name forall a b. a -> (a -> b) -> b
|> String -> Text
T.pack) (forall a. Eq a => a -> a -> Bool
== UnqualComponentName
name)
addOptionsForAll :: [String] -> Uusi
addOptionsForAll :: [String] -> Uusi
addOptionsForAll [String]
opts =
forall tag.
tag -> (UnqualComponentName -> Bool) -> Op [String] -> Action tag
ModifyBuiltOptions
(Text
"Add " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show [String]
opts) forall a. Semigroup a => a -> a -> a
<> Text
" to all components and the library")
(forall a b. a -> b -> a
const Bool
True)
(forall a. Semigroup a => a -> a -> a
<> [String]
opts)
removeOptionsForAll :: [String] -> Uusi
removeOptionsForAll :: [String] -> Uusi
removeOptionsForAll [String]
opts =
forall tag.
tag -> (UnqualComponentName -> Bool) -> Op [String] -> Action tag
ModifyBuiltOptions
(Text
"Remove " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show [String]
opts) forall a. Semigroup a => a -> a -> a
<> Text
" from all components and the library")
(forall a b. a -> b -> a
const Bool
True)
(forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
opts))
uusiRange' :: HasVersionedPackage a => Uusi -> Op a
uusiRange' :: forall a. HasVersionedPackage a => Uusi -> Op a
uusiRange' (SetVersion Text
_ PackageName -> Bool
p VersionRange
range) a
x
| PackageName -> Bool
p forall a b. (a -> b) -> a -> b
$ a
x forall s a. s -> Getting a s a -> a
^. forall a. HasVersionedPackage a => Lens' a PackageName
myPkgName = a
x forall a b. a -> (a -> b) -> b
& forall a. HasVersionedPackage a => Lens' a VersionRange
myVersionRange forall s t a b. ASetter s t a b -> b -> s -> t
.~ VersionRange
range
| Bool
otherwise = a
x
uusiRange' Uusi
_ a
x = a
x
uusiRange :: HasVersionedPackage a => Uusis -> Op a
uusiRange :: forall a. HasVersionedPackage a => Uusis -> Op a
uusiRange Uusis
actions = forall a. [Op a] -> Op a
chain forall a b. (a -> b) -> a -> b
<| forall a. HasVersionedPackage a => Uusi -> Op a
uusiRange' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uusis
actions
uusiReplace' :: HasVersionedPackage a => Uusi -> a -> [a]
uusiReplace' :: forall a. HasVersionedPackage a => Uusi -> a -> [a]
uusiReplace' (Replace Text
_ PackageName -> Bool
p [VersionedPackage]
targets) a
x
| PackageName -> Bool
p forall a b. (a -> b) -> a -> b
$ a
x forall s a. s -> Getting a s a -> a
^. forall a. HasVersionedPackage a => Lens' a PackageName
myPkgName =
( \VersionedPackage
t ->
a
x
forall a b. a -> (a -> b) -> b
& forall a. HasVersionedPackage a => Lens' a PackageName
myPkgName forall s t a b. ASetter s t a b -> b -> s -> t
.~ VersionedPackage
t forall s a. s -> Getting a s a -> a
^. forall a. HasVersionedPackage a => Lens' a PackageName
myPkgName
forall a b. a -> (a -> b) -> b
& forall a. HasVersionedPackage a => Lens' a VersionRange
myVersionRange forall s t a b. ASetter s t a b -> b -> s -> t
.~ VersionedPackage
t forall s a. s -> Getting a s a -> a
^. forall a. HasVersionedPackage a => Lens' a VersionRange
myVersionRange
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionedPackage]
targets
| Bool
otherwise = []
uusiReplace' Uusi
_ a
_ = []
uusiReplace :: (HasVersionedPackage a, Eq a) => Uusis -> Op [a]
uusiReplace :: forall a. (HasVersionedPackage a, Eq a) => Uusis -> Op [a]
uusiReplace Uusis
actions [a]
t =
let k :: [(a, Maybe a)]
k = [(a
r', if Bool
success then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing) | a
x <- [a]
t, Uusi
a <- Uusis
actions, let r :: [a]
r = forall a. HasVersionedPackage a => Uusi -> a -> [a]
uusiReplace' Uusi
a a
x, let success :: Bool
success = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
r, a
r' <- [a]
r]
kf :: [a]
kf = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Maybe a)]
k
ks :: [a]
ks = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Maybe a)]
k
in
[a]
kf forall a. Semigroup a => a -> a -> a
<> ([a]
t forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
ks)
uusiRemove :: HasVersionedPackage a => Uusis -> Op [a]
uusiRemove :: forall a. HasVersionedPackage a => Uusis -> Op [a]
uusiRemove Uusis
actions [a]
t = let ps :: [PackageName -> Bool]
ps = [PackageName -> Bool
p | (Remove Text
_ PackageName -> Bool
p) <- Uusis
actions] in forall a. (a -> Bool) -> [a] -> [a]
filter (\a
x -> forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
<| forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
<| (a
x forall s a. s -> Getting a s a -> a
^. forall a. HasVersionedPackage a => Lens' a PackageName
myPkgName))) [PackageName -> Bool]
ps) [a]
t
uusiBuildable :: HasBuildInfo a => Uusis -> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiBuildable :: forall a.
HasBuildInfo a =>
Uusis -> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiBuildable Uusis
actions (UnqualComponentName, CondTree ConfVar [Dependency] a)
t
| (UnqualComponentName
name, CondTree ConfVar [Dependency] a
tree) <- (UnqualComponentName, CondTree ConfVar [Dependency] a)
t,
(Bool
b : [Bool]
_) <- [Bool
b | (SetBuildable Text
_ UnqualComponentName -> Bool
p Bool
b) <- Uusis
actions, UnqualComponentName -> Bool
p UnqualComponentName
name] =
(UnqualComponentName
name, forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (forall a. HasBuildInfo a => Lens' a BuildInfo
buildInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. HasBuildInfo a => Lens' a Bool
buildable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
b) CondTree ConfVar [Dependency] a
tree)
| Bool
otherwise = (UnqualComponentName, CondTree ConfVar [Dependency] a)
t
uusiOptions' :: HasBuildInfo a => Action tag -> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions' :: forall a tag.
HasBuildInfo a =>
Action tag
-> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions' (ModifyBuiltOptions tag
_ UnqualComponentName -> Bool
p Op [String]
f) (UnqualComponentName, CondTree ConfVar [Dependency] a)
x
| (UnqualComponentName
name, CondTree ConfVar [Dependency] a
tree) <- (UnqualComponentName, CondTree ConfVar [Dependency] a)
x,
UnqualComponentName -> Bool
p UnqualComponentName
name =
(UnqualComponentName
name, forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (forall a. HasBuildInfo a => Lens' a BuildInfo
buildInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [String])
options forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \(PerCompilerFlavor [String]
ghc [String]
ghcjs) -> forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor (Op [String]
f [String]
ghc) [String]
ghcjs) CondTree ConfVar [Dependency] a
tree)
uusiOptions' Action tag
_ (UnqualComponentName, CondTree ConfVar [Dependency] a)
x = (UnqualComponentName, CondTree ConfVar [Dependency] a)
x
uusiOptions :: HasBuildInfo a => [Action tag] -> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions :: forall a tag.
HasBuildInfo a =>
[Action tag]
-> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions [Action tag]
actions = forall a. [Op a] -> Op a
chain forall a b. (a -> b) -> a -> b
<| forall a tag.
HasBuildInfo a =>
Action tag
-> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Action tag]
actions
uusiBuildInfo :: Uusis -> Op BuildInfo
uusiBuildInfo :: Uusis -> BuildInfo -> BuildInfo
uusiBuildInfo Uusis
actions BuildInfo
i =
BuildInfo
i
forall a b. a -> (a -> b) -> b
|> (forall a. HasBuildInfo a => Lens' a [Dependency]
targetBuildDepends forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasVersionedPackage a => Uusis -> Op a
uusiRange Uusis
actions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasVersionedPackage a, Eq a) => Uusis -> Op [a]
uusiReplace Uusis
actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasVersionedPackage a => Uusis -> Op [a]
uusiRemove Uusis
actions)
forall a b. a -> (a -> b) -> b
|> (forall a. HasBuildInfo a => Lens' a [ExeDependency]
buildToolDepends forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasVersionedPackage a => Uusis -> Op a
uusiRange Uusis
actions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasVersionedPackage a, Eq a) => Uusis -> Op [a]
uusiReplace Uusis
actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasVersionedPackage a => Uusis -> Op [a]
uusiRemove Uusis
actions)
forall a b. a -> (a -> b) -> b
|> (forall a. HasBuildInfo a => Lens' a [LegacyExeDependency]
buildTools forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasVersionedPackage a => Uusis -> Op a
uusiRange Uusis
actions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasVersionedPackage a, Eq a) => Uusis -> Op [a]
uusiReplace Uusis
actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasVersionedPackage a => Uusis -> Op [a]
uusiRemove Uusis
actions)
uusiCondTree :: (HasBuildInfo a) => Uusis -> Op (CondTree ConfVar [Dependency] a)
uusiCondTree :: forall a.
HasBuildInfo a =>
Uusis -> Op (CondTree ConfVar [Dependency] a)
uusiCondTree Uusis
actions = forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (forall a. HasBuildInfo a => Lens' a BuildInfo
buildInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Uusis -> BuildInfo -> BuildInfo
uusiBuildInfo Uusis
actions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c d v a. (c -> d) -> CondTree v c a -> CondTree v d a
mapTreeConstrs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasVersionedPackage a => Uusis -> Op a
uusiRange Uusis
actions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasVersionedPackage a, Eq a) => Uusis -> Op [a]
uusiReplace Uusis
actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasVersionedPackage a => Uusis -> Op [a]
uusiRemove Uusis
actions)
uusiGenericPackageDescription ::
Uusis ->
Op GenericPackageDescription
uusiGenericPackageDescription :: Uusis -> Op GenericPackageDescription
uusiGenericPackageDescription Uusis
actions GenericPackageDescription
cabal =
GenericPackageDescription
cabal
forall a b. a -> (a -> b) -> b
|> (Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {f :: * -> *} {a}.
(Functor f, HasBuildInfo a) =>
f (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiTrees)
forall a b. a -> (a -> b) -> b
|> (Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {f :: * -> *} {a}.
(Functor f, HasBuildInfo a) =>
f (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiTrees)
forall a b. a -> (a -> b) -> b
|> (Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {f :: * -> *} {a}.
(Functor f, HasBuildInfo a) =>
f (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiTrees)
forall a b. a -> (a -> b) -> b
|> (Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {f :: * -> *} {a}.
(Functor f, HasBuildInfo a) =>
f (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiTrees)
forall a b. a -> (a -> b) -> b
|> (Lens'
GenericPackageDescription
(Maybe (CondTree ConfVar [Dependency] Library))
condLibrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mapped forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a.
HasBuildInfo a =>
Uusis -> Op (CondTree ConfVar [Dependency] a)
uusiCondTree Uusis
actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a tag.
HasBuildInfo a =>
[Action tag]
-> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions Uusis
actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName
"library",)))
where
uusiTrees :: f (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiTrees f (UnqualComponentName, CondTree ConfVar [Dependency] a)
trees = f (UnqualComponentName, CondTree ConfVar [Dependency] a)
trees forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall c a b. Lens (c, a) (c, b) a b
_2 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a.
HasBuildInfo a =>
Uusis -> Op (CondTree ConfVar [Dependency] a)
uusiCondTree Uusis
actions forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a.
HasBuildInfo a =>
Uusis -> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiBuildable Uusis
actions forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a tag.
HasBuildInfo a =>
[Action tag]
-> Op (UnqualComponentName, CondTree ConfVar [Dependency] a)
uusiOptions Uusis
actions