module CabalLenses.Section
   ( Section(..)
   , allSections
   ) where

import Distribution.PackageDescription (GenericPackageDescription(..))
import Distribution.Types.UnqualComponentName (unUnqualComponentName)

type Name = String

-- | A section of the cabal file.
data Section = Library
             | Executable Name
             | TestSuite Name
             | Benchmark Name
             deriving (Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Section -> ShowS
showsPrec :: Int -> Section -> ShowS
$cshow :: Section -> String
show :: Section -> String
$cshowList :: [Section] -> ShowS
showList :: [Section] -> ShowS
Show, Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
/= :: Section -> Section -> Bool
Eq)


-- | All sections defined in 'GenericPackageDescription'.
allSections :: GenericPackageDescription -> [Section]
allSections :: GenericPackageDescription -> [Section]
allSections GenericPackageDescription
pkgDescr =
   [[Section]] -> [Section]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Section]
-> (CondTree ConfVar [Dependency] Library -> [Section])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [Section]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Section] -> CondTree ConfVar [Dependency] Library -> [Section]
forall a b. a -> b -> a
const [Section
Library]) (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkgDescr)
          , ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Section)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Section]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Section
Executable (String -> Section)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkgDescr)
          , ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> Section)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [Section]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Section
TestSuite (String -> Section)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkgDescr)
          , ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Section)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Section]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Section
Benchmark (String -> Section)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkgDescr)
          ]