{-# LANGUAGE PatternGuards, Rank2Types, CPP #-}

module CabalBounds.Dependencies
   ( Dependencies(..)
   , dependencies
   , filterDependency
   , allDependency
   , dependencyIf
   , filterLibrary
   ) where

import Control.Lens
import qualified CabalBounds.Args as A
import qualified CabalLenses as CL
import CabalBounds.Types
import Distribution.Package (Dependency(..), unPackageName)
import Distribution.PackageDescription (GenericPackageDescription)

-- | Which dependencies in the cabal file should the considered.
data Dependencies = AllDependencies              -- ^ all dependencies
                  | OnlyDependencies [String]    -- ^ only the listed dependencies
                  | IgnoreDependencies [String]  -- ^ all dependencies but the listed ones
                  deriving (Int -> Dependencies -> ShowS
[Dependencies] -> ShowS
Dependencies -> String
(Int -> Dependencies -> ShowS)
-> (Dependencies -> String)
-> ([Dependencies] -> ShowS)
-> Show Dependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dependencies -> ShowS
showsPrec :: Int -> Dependencies -> ShowS
$cshow :: Dependencies -> String
show :: Dependencies -> String
$cshowList :: [Dependencies] -> ShowS
showList :: [Dependencies] -> ShowS
Show, Dependencies -> Dependencies -> Bool
(Dependencies -> Dependencies -> Bool)
-> (Dependencies -> Dependencies -> Bool) -> Eq Dependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dependencies -> Dependencies -> Bool
== :: Dependencies -> Dependencies -> Bool
$c/= :: Dependencies -> Dependencies -> Bool
/= :: Dependencies -> Dependencies -> Bool
Eq)


dependencies :: A.Args -> Dependencies
dependencies :: Args -> Dependencies
dependencies Args
args
   | ds :: [String]
ds@(String
_:[String]
_) <- Args -> [String]
A.only Args
args
   = [String] -> Dependencies
OnlyDependencies [String]
ds

   | ds :: [String]
ds@(String
_:[String]
_) <- Args -> [String]
A.ignore Args
args
   = [String] -> Dependencies
IgnoreDependencies [String]
ds

   | Bool
otherwise
   = Dependencies
AllDependencies


filterDependency :: Dependencies -> Traversal' Dependency Dependency
filterDependency :: Dependencies -> Traversal' Dependency Dependency
filterDependency Dependencies
AllDependencies =
   (Dependency -> Bool)
-> (Dependency -> f Dependency) -> Dependency -> f Dependency
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Bool -> Dependency -> Bool
forall a b. a -> b -> a
const Bool
True)

filterDependency (OnlyDependencies [String]
deps) =
   (Dependency -> Bool)
-> (Dependency -> f Dependency) -> Dependency -> f Dependency
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
_) -> (PackageName -> String
unPackageName PackageName
pkg) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
deps)

filterDependency (IgnoreDependencies [String]
deps) =
   (Dependency -> Bool)
-> (Dependency -> f Dependency) -> Dependency -> f Dependency
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
_) -> (PackageName -> String
unPackageName PackageName
pkg) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
deps)


-- | A traversal for all 'Dependency' of all 'Section'.
allDependency :: Traversal' GenericPackageDescription Dependency
allDependency :: Traversal' GenericPackageDescription Dependency
allDependency =
#if MIN_VERSION_Cabal(1,22,1)
   (BuildInfo -> f BuildInfo)
-> GenericPackageDescription -> f GenericPackageDescription
Traversal' GenericPackageDescription BuildInfo
CL.allBuildInfo ((BuildInfo -> f BuildInfo)
 -> GenericPackageDescription -> f GenericPackageDescription)
-> ((Dependency -> f Dependency) -> BuildInfo -> f BuildInfo)
-> (Dependency -> f Dependency)
-> GenericPackageDescription
-> f GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Dependency] -> f [Dependency]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [Dependency]
CL.targetBuildDependsL (([Dependency] -> f [Dependency]) -> BuildInfo -> f BuildInfo)
-> ((Dependency -> f Dependency) -> [Dependency] -> f [Dependency])
-> (Dependency -> f Dependency)
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> f Dependency) -> [Dependency] -> f [Dependency]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [Dependency] [Dependency] Dependency Dependency
traversed
#else
   CL.allDependency
#endif


-- | A traversal for the 'Dependency' of 'Section' that match 'CondVars'.
dependencyIf :: CL.CondVars -> CL.Section -> Traversal' GenericPackageDescription Dependency
dependencyIf :: CondVars
-> Section -> Traversal' GenericPackageDescription Dependency
dependencyIf CondVars
condVars Section
section =
#if MIN_VERSION_Cabal(1,22,1)
   CondVars
-> Section -> Traversal' GenericPackageDescription BuildInfo
CL.buildInfoIf CondVars
condVars Section
section ((BuildInfo -> f BuildInfo)
 -> GenericPackageDescription -> f GenericPackageDescription)
-> ((Dependency -> f Dependency) -> BuildInfo -> f BuildInfo)
-> (Dependency -> f Dependency)
-> GenericPackageDescription
-> f GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Dependency] -> f [Dependency]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [Dependency]
CL.targetBuildDependsL (([Dependency] -> f [Dependency]) -> BuildInfo -> f BuildInfo)
-> ((Dependency -> f Dependency) -> [Dependency] -> f [Dependency])
-> (Dependency -> f Dependency)
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> f Dependency) -> [Dependency] -> f [Dependency]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [Dependency] [Dependency] Dependency Dependency
traversed
#else
   CL.dependencyIf condVars section
#endif


filterLibrary :: Dependencies -> Traversal' Library Library
filterLibrary :: Dependencies -> Traversal' Library Library
filterLibrary Dependencies
AllDependencies =
   (Library -> Bool) -> (Library -> f Library) -> Library -> f Library
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Bool -> Library -> Bool
forall a b. a -> b -> a
const Bool
True)

filterLibrary (OnlyDependencies [String]
deps) =
   (Library -> Bool) -> (Library -> f Library) -> Library -> f Library
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(String
libName, LibVersion
_) -> String
libName String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
deps)

filterLibrary (IgnoreDependencies [String]
deps) =
   (Library -> Bool) -> (Library -> f Library) -> Library -> f Library
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(String
libName, LibVersion
_) -> String
libName String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
deps)