{-# LANGUAGE PatternGuards #-}

module CabalBounds.Sections
   ( sections
   ) where

import Distribution.PackageDescription (GenericPackageDescription)
import CabalBounds.Args (Args)
import qualified CabalBounds.Args as A
import qualified CabalLenses as CL

sections :: Args -> GenericPackageDescription -> [CL.Section]
sections :: Args -> GenericPackageDescription -> [Section]
sections Args
args GenericPackageDescription
pkgDescrp
   | ss :: [Section]
ss@(Section
_:[Section]
_) <- [[Section]] -> [Section]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ Section
CL.Library | Args -> Bool
A.library Args
args ]
                        , (Name -> Section) -> [Name] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Section
CL.Executable (Args -> [Name]
A.executable Args
args)
                        , (Name -> Section) -> [Name] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Section
CL.TestSuite (Args -> [Name]
A.testSuite Args
args)
                        , (Name -> Section) -> [Name] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Section
CL.Benchmark (Args -> [Name]
A.benchmark Args
args)
                        ]
   = [Section]
ss

   | Bool
otherwise
   = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp