{-# LANGUAGE RankNTypes #-}

-- | Velma is a Haskell package that makes it easy to automatically add files
-- to @exposed-modules@ and @other-modules@ in Cabal package descriptions.
--
-- == Motivation
--
-- When working on a Haskell application, it can get tedious to update the
-- package description (@*.cabal@ file) every time you add, rename, or remove a
-- module. What's worse is that Cabal can clearly figure this out on its own
-- since it warns you about it!
--
-- > <no location info>: warning: [-Wmissing-home-modules]
-- >     These modules are needed for compilation but not listed in your .cabal file's other-modules:
-- >         Velma.SymbolicPath
--
-- So what gives? The package description is in an unfortunate situation: It's
-- meant to be a human writable file, but it's also meant to be machine
-- readable. When someone uploads a package to Hackage, it's important that all
-- of that package's modules be known statically.
--
-- But many Haskell projects are never going to be uploaded to Hackage, and the
-- list of exposed modules is essentially just every Haskell file in some
-- directory. That's the problem that Velma aims to solve.
--
-- == Usage
--
-- Velma is implemented as a custom setup script. Read more about them here:
-- <https://cabal.readthedocs.io/en/3.6/cabal-package.html#custom-setup-scripts>.
--
-- To use Velma, you need to do a few things:
--
-- -   Change your build type from @Simple@ to @Custom@:
--
--     > -- *.cabal
--     >
--     > build-type: Custom
--
--     If your @*.cabal@ file does not already have a @build-type@ field then
--     just add it and set it to @Custom@.
--
--     If you're already using a custom setup script, then you probably know
--     what you're doing. You'll probably want to integrate Velma's 'confHook'
--     into your custom setup.
--
-- -   Add a @custom-setup@ stanza:
--
--     > -- *.cabal
--     >
--     > custom-setup
--     >     setup-depends: base, Cabal, velma
--
--     If you're using @cabal-install@ then you can remove the @Cabal@
--     dependency. For some reason Stack requires it.
--
-- -   Add @Velma.Discover@ to your @exposed-modules@ or @other-modules@:
--
--     > -- *.cabal
--     >
--     > library
--     >     exposed-modules: Velma.Discover
--
--     Velma will only discover modules in places where @Velma.Discover@ is
--     present. That means you can explicitly list your @exposed-modules@ but
--     let Velma discover your @other-modules@. Or you can use Velma only for
--     your test suite. It's up to you!
--
-- -   Create a @Setup.hs@ file:
--
--     > -- Setup.hs
--     >
--     > import Velma
--     > main = defaultMain
--
-- == Limitations
--
-- -   Only @*.hs@ files are discovered.
--
-- -   All conditionals are ignored.
--
-- -   The @cabal sdist@ command will not automatically discover modules. This
--     will likely lead to an error such as this: "Setup.hs: Error: Could not
--     find module: Velma.Discover with any suffix: [...]. If the module is
--     autogenerated it should be added to 'autogen-modules'."
--     <https://github.com/haskell/cabal/issues/3424>
--
-- -   The @stack build@ command will generate warnings about missing modules.
--     This warning is safe to ignore. Unfortunately it's visually noisy and
--     there's no way to disable it.
--     <https://github.com/commercialhaskell/stack/issues/1881>
module Velma where

import qualified Control.Monad as Monad
import qualified Data.Containers.ListUtils as ListUtils
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Distribution.Compat.Lens as Lens
import qualified Distribution.ModuleName as ModuleName
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Simple as Cabal
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.Types.BenchmarkInterface as BenchmarkInterface
import qualified Distribution.Types.CondTree as CondTree
import qualified Distribution.Types.HookedBuildInfo as HookedBuildInfo
import qualified Distribution.Types.Lens as Cabal
import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo
import qualified Distribution.Types.TestSuiteInterface as TestSuiteInterface
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import qualified Velma.SymbolicPath as SymbolicPath

-- | The default entrypoint for this custom setup script. This calls Cabal's
-- 'Cabal.defaultMainWithHooks' with our custom 'userHooks'.
--
-- If you're trying to use Velma in your own project, you should create a
-- @Setup.hs@ file like this:
--
-- > -- Setup.hs
-- > import Velma
-- > main = defaultMain
defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = UserHooks -> IO ()
Cabal.defaultMainWithHooks UserHooks
userHooks

-- | Like Cabal's 'Cabal.simpleUserHooks' but with our custom 'confHook'.
userHooks :: Cabal.UserHooks
userHooks :: UserHooks
userHooks = UserHooks
Cabal.simpleUserHooks { confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
Cabal.confHook = (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook }

-- | Calls 'discover' before handing things off to the 'Cabal.confHook' from
-- Cabal's 'Cabal.simpleUserHooks'.
confHook
    :: (Cabal.GenericPackageDescription, HookedBuildInfo.HookedBuildInfo)
    -> Cabal.ConfigFlags
    -> IO LocalBuildInfo.LocalBuildInfo
confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook (GenericPackageDescription
gpd1, HookedBuildInfo
hbi) ConfigFlags
cf = do
    GenericPackageDescription
gpd2 <- GenericPackageDescription -> IO GenericPackageDescription
discover GenericPackageDescription
gpd1
    UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
Cabal.confHook UserHooks
Cabal.simpleUserHooks (GenericPackageDescription
gpd2, HookedBuildInfo
hbi) ConfigFlags
cf

-- | Simply calls 'discoverWith' with 'listDirectoryRecursively'.
discover
    :: Cabal.GenericPackageDescription -> IO Cabal.GenericPackageDescription
discover :: GenericPackageDescription -> IO GenericPackageDescription
discover = (FilePath -> IO [FilePath])
-> GenericPackageDescription -> IO GenericPackageDescription
forall (m :: * -> *).
Monad m =>
(FilePath -> m [FilePath])
-> GenericPackageDescription -> m GenericPackageDescription
discoverWith FilePath -> IO [FilePath]
listDirectoryRecursively

-- | Discovers modules in all of the components of this package description.
-- You can think of this function as calling 'discoverComponent' for each
-- component: library, sub-libraries, foreign libraries, executables, test
-- suites, and benchmarks.
discoverWith
    :: Monad m
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> Cabal.GenericPackageDescription
    -> m Cabal.GenericPackageDescription
discoverWith :: (FilePath -> m [FilePath])
-> GenericPackageDescription -> m GenericPackageDescription
discoverWith FilePath -> m [FilePath]
f = [GenericPackageDescription -> m GenericPackageDescription]
-> GenericPackageDescription -> m GenericPackageDescription
forall (m :: * -> *) a. Monad m => [a -> m a] -> a -> m a
concatM
    [ Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
-> (Maybe (CondTree ConfVar [Dependency] Library)
    -> m (Maybe (CondTree ConfVar [Dependency] Library)))
-> GenericPackageDescription
-> m GenericPackageDescription
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
Cabal.condLibrary ((CondTree ConfVar [Dependency] Library
 -> m (CondTree ConfVar [Dependency] Library))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> m (Maybe (CondTree ConfVar [Dependency] Library))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((CondTree ConfVar [Dependency] Library
  -> m (CondTree ConfVar [Dependency] Library))
 -> Maybe (CondTree ConfVar [Dependency] Library)
 -> m (Maybe (CondTree ConfVar [Dependency] Library)))
-> ((Library -> m Library)
    -> CondTree ConfVar [Dependency] Library
    -> m (CondTree ConfVar [Dependency] Library))
-> (Library -> m Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> m (Maybe (CondTree ConfVar [Dependency] Library))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' (CondTree ConfVar [Dependency] Library) Library
-> (Library -> m Library)
-> CondTree ConfVar [Dependency] Library
-> m (CondTree ConfVar [Dependency] Library)
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF forall v c a. Lens' (CondTree v c a) a
Lens' (CondTree ConfVar [Dependency] Library) Library
condTreeData ((Library -> m Library)
 -> Maybe (CondTree ConfVar [Dependency] Library)
 -> m (Maybe (CondTree ConfVar [Dependency] Library)))
-> (Library -> m Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> m (Maybe (CondTree ConfVar [Dependency] Library))
forall a b. (a -> b) -> a -> b
$ (FilePath -> m [FilePath]) -> Library -> m Library
forall (m :: * -> *).
Monad m =>
(FilePath -> m [FilePath]) -> Library -> m Library
discoverLibrary FilePath -> m [FilePath]
f)
    , Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
    -> m [(UnqualComponentName,
           CondTree ConfVar [Dependency] Library)])
-> GenericPackageDescription
-> m GenericPackageDescription
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF
        Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
Cabal.condSubLibraries
        (((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> m (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> m [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((UnqualComponentName, CondTree ConfVar [Dependency] Library)
  -> m (UnqualComponentName, CondTree ConfVar [Dependency] Library))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] Library)])
-> ((Library -> m Library)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> m (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> (Library -> m Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> m [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  Library
-> (Library -> m Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> m (UnqualComponentName, CondTree ConfVar [Dependency] Library)
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF (LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
forall c a b. Lens (c, a) (c, b) a b
Lens._2 LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (UnqualComponentName, CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
  (CondTree ConfVar [Dependency] Library)
-> ((Library -> f Library)
    -> CondTree ConfVar [Dependency] Library
    -> f (CondTree ConfVar [Dependency] Library))
-> (Library -> f Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> f Library)
-> CondTree ConfVar [Dependency] Library
-> f (CondTree ConfVar [Dependency] Library)
forall v c a. Lens' (CondTree v c a) a
condTreeData) ((Library -> m Library)
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] Library)])
-> (Library -> m Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> m [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> m [FilePath]) -> Library -> m Library
forall (m :: * -> *).
Monad m =>
(FilePath -> m [FilePath]) -> Library -> m Library
discoverLibrary FilePath -> m [FilePath]
f)
    , Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> ([(UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)]
    -> m [(UnqualComponentName,
           CondTree ConfVar [Dependency] ForeignLib)])
-> GenericPackageDescription
-> m GenericPackageDescription
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF
        Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
Cabal.condForeignLibs
        (((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> m (UnqualComponentName,
       CondTree ConfVar [Dependency] ForeignLib))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] ForeignLib)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  -> m (UnqualComponentName,
        CondTree ConfVar [Dependency] ForeignLib))
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] ForeignLib)])
-> ((ForeignLib -> m ForeignLib)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
    -> m (UnqualComponentName,
          CondTree ConfVar [Dependency] ForeignLib))
-> (ForeignLib -> m ForeignLib)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] ForeignLib)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  ForeignLib
-> (ForeignLib -> m ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> m (UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF (LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
forall c a b. Lens (c, a) (c, b) a b
Lens._2 LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
  (CondTree ConfVar [Dependency] ForeignLib)
-> ((ForeignLib -> f ForeignLib)
    -> CondTree ConfVar [Dependency] ForeignLib
    -> f (CondTree ConfVar [Dependency] ForeignLib))
-> (ForeignLib -> f ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> f (UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeignLib -> f ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> f (CondTree ConfVar [Dependency] ForeignLib)
forall v c a. Lens' (CondTree v c a) a
condTreeData) ((ForeignLib -> m ForeignLib)
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] ForeignLib)])
-> (ForeignLib -> m ForeignLib)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] ForeignLib)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> m [FilePath]) -> ForeignLib -> m ForeignLib
forall (m :: * -> *).
Applicative m =>
(FilePath -> m [FilePath]) -> ForeignLib -> m ForeignLib
discoverForeignLib FilePath -> m [FilePath]
f)
    , Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> ([(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
    -> m [(UnqualComponentName,
           CondTree ConfVar [Dependency] Executable)])
-> GenericPackageDescription
-> m GenericPackageDescription
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF
        Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
Cabal.condExecutables
        (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> m (UnqualComponentName,
       CondTree ConfVar [Dependency] Executable))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] Executable)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  -> m (UnqualComponentName,
        CondTree ConfVar [Dependency] Executable))
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] Executable)])
-> ((Executable -> m Executable)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> m (UnqualComponentName,
          CondTree ConfVar [Dependency] Executable))
-> (Executable -> m Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] Executable)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  Executable
-> (Executable -> m Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> m (UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF (LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
forall c a b. Lens (c, a) (c, b) a b
Lens._2 LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
  (CondTree ConfVar [Dependency] Executable)
-> ((Executable -> f Executable)
    -> CondTree ConfVar [Dependency] Executable
    -> f (CondTree ConfVar [Dependency] Executable))
-> (Executable -> f Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> f (UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> f Executable)
-> CondTree ConfVar [Dependency] Executable
-> f (CondTree ConfVar [Dependency] Executable)
forall v c a. Lens' (CondTree v c a) a
condTreeData) ((Executable -> m Executable)
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] Executable)])
-> (Executable -> m Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] Executable)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> m [FilePath]) -> Executable -> m Executable
forall (m :: * -> *).
Applicative m =>
(FilePath -> m [FilePath]) -> Executable -> m Executable
discoverExecutable FilePath -> m [FilePath]
f)
    , Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> ([(UnqualComponentName,
      CondTree ConfVar [Dependency] TestSuite)]
    -> m [(UnqualComponentName,
           CondTree ConfVar [Dependency] TestSuite)])
-> GenericPackageDescription
-> m GenericPackageDescription
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF
        Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
Cabal.condTestSuites
        (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> m (UnqualComponentName,
       CondTree ConfVar [Dependency] TestSuite))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] TestSuite)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  -> m (UnqualComponentName,
        CondTree ConfVar [Dependency] TestSuite))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] TestSuite)])
-> ((TestSuite -> m TestSuite)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> m (UnqualComponentName,
          CondTree ConfVar [Dependency] TestSuite))
-> (TestSuite -> m TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] TestSuite)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  TestSuite
-> (TestSuite -> m TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> m (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF (LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
forall c a b. Lens (c, a) (c, b) a b
Lens._2 LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
  (CondTree ConfVar [Dependency] TestSuite)
-> ((TestSuite -> f TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite
    -> f (CondTree ConfVar [Dependency] TestSuite))
-> (TestSuite -> f TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestSuite -> f TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> f (CondTree ConfVar [Dependency] TestSuite)
forall v c a. Lens' (CondTree v c a) a
condTreeData) ((TestSuite -> m TestSuite)
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] TestSuite)])
-> (TestSuite -> m TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] TestSuite)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> m [FilePath]) -> TestSuite -> m TestSuite
forall (m :: * -> *).
Applicative m =>
(FilePath -> m [FilePath]) -> TestSuite -> m TestSuite
discoverTestSuite FilePath -> m [FilePath]
f)
    , Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> ([(UnqualComponentName,
      CondTree ConfVar [Dependency] Benchmark)]
    -> m [(UnqualComponentName,
           CondTree ConfVar [Dependency] Benchmark)])
-> GenericPackageDescription
-> m GenericPackageDescription
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF
        Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
Cabal.condBenchmarks
        (((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> m (UnqualComponentName,
       CondTree ConfVar [Dependency] Benchmark))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] Benchmark)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  -> m (UnqualComponentName,
        CondTree ConfVar [Dependency] Benchmark))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] Benchmark)])
-> ((Benchmark -> m Benchmark)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> m (UnqualComponentName,
          CondTree ConfVar [Dependency] Benchmark))
-> (Benchmark -> m Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] Benchmark)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  Benchmark
-> (Benchmark -> m Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> m (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
forall (f :: * -> *) s a.
Functor f =>
Lens' s a -> (a -> f a) -> s -> f s
overF (LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
forall c a b. Lens (c, a) (c, b) a b
Lens._2 LensLike
  f
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
  (CondTree ConfVar [Dependency] Benchmark)
-> ((Benchmark -> f Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark
    -> f (CondTree ConfVar [Dependency] Benchmark))
-> (Benchmark -> f Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> f (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark -> f Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> f (CondTree ConfVar [Dependency] Benchmark)
forall v c a. Lens' (CondTree v c a) a
condTreeData) ((Benchmark -> m Benchmark)
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> m [(UnqualComponentName,
        CondTree ConfVar [Dependency] Benchmark)])
-> (Benchmark -> m Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> m [(UnqualComponentName,
       CondTree ConfVar [Dependency] Benchmark)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> m [FilePath]) -> Benchmark -> m Benchmark
forall (m :: * -> *).
Applicative m =>
(FilePath -> m [FilePath]) -> Benchmark -> m Benchmark
discoverBenchmark FilePath -> m [FilePath]
f)
    ]

-- | Thin wrapper around 'discoverComponent' for libraries.
discoverLibrary
    :: Monad m
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> Cabal.Library
    -> m Cabal.Library
discoverLibrary :: (FilePath -> m [FilePath]) -> Library -> m Library
discoverLibrary FilePath -> m [FilePath]
f = [Library -> m Library] -> Library -> m Library
forall (m :: * -> *) a. Monad m => [a -> m a] -> a -> m a
concatM
    [ Lens' Library [ModuleName]
-> (Library -> [ModuleName])
-> (FilePath -> m [FilePath])
-> Library
-> m Library
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent Lens' Library [ModuleName]
Cabal.exposedModules (Getting [ModuleName] Library [ModuleName]
-> Library -> [ModuleName]
forall a s. Getting a s a -> s -> a
Lens.view Getting [ModuleName] Library [ModuleName]
forall a. HasBuildInfo a => Lens' a [ModuleName]
Cabal.otherModules) FilePath -> m [FilePath]
f
    , Lens' Library [ModuleName]
-> (Library -> [ModuleName])
-> (FilePath -> m [FilePath])
-> Library
-> m Library
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent forall a. HasBuildInfo a => Lens' a [ModuleName]
Lens' Library [ModuleName]
Cabal.otherModules (Getting [ModuleName] Library [ModuleName]
-> Library -> [ModuleName]
forall a s. Getting a s a -> s -> a
Lens.view Getting [ModuleName] Library [ModuleName]
Lens' Library [ModuleName]
Cabal.exposedModules) FilePath -> m [FilePath]
f
    ]

-- | Thin wrapper around 'discoverComponent' for foreign libraries.
discoverForeignLib
    :: Applicative m
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> Cabal.ForeignLib
    -> m Cabal.ForeignLib
discoverForeignLib :: (FilePath -> m [FilePath]) -> ForeignLib -> m ForeignLib
discoverForeignLib = Lens' ForeignLib [ModuleName]
-> (ForeignLib -> [ModuleName])
-> (FilePath -> m [FilePath])
-> ForeignLib
-> m ForeignLib
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent forall a. HasBuildInfo a => Lens' a [ModuleName]
Lens' ForeignLib [ModuleName]
Cabal.otherModules ((ForeignLib -> [ModuleName])
 -> (FilePath -> m [FilePath]) -> ForeignLib -> m ForeignLib)
-> (ForeignLib -> [ModuleName])
-> (FilePath -> m [FilePath])
-> ForeignLib
-> m ForeignLib
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> ForeignLib -> [ModuleName]
forall a b. a -> b -> a
const []

-- | Thin wrapper around 'discoverComponent' for executables.
discoverExecutable
    :: Applicative m
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> Cabal.Executable
    -> m Cabal.Executable
discoverExecutable :: (FilePath -> m [FilePath]) -> Executable -> m Executable
discoverExecutable =
    Lens' Executable [ModuleName]
-> (Executable -> [ModuleName])
-> (FilePath -> m [FilePath])
-> Executable
-> m Executable
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent forall a. HasBuildInfo a => Lens' a [ModuleName]
Lens' Executable [ModuleName]
Cabal.otherModules
        ((Executable -> [ModuleName])
 -> (FilePath -> m [FilePath]) -> Executable -> m Executable)
-> (Executable -> [ModuleName])
-> (FilePath -> m [FilePath])
-> Executable
-> m Executable
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
Maybe.maybeToList
        (Maybe ModuleName -> [ModuleName])
-> (Executable -> Maybe ModuleName) -> Executable -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe ModuleName
filePathToModuleName
        (FilePath -> Maybe ModuleName)
-> (Executable -> FilePath) -> Executable -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting FilePath Executable FilePath -> Executable -> FilePath
forall a s. Getting a s a -> s -> a
Lens.view Getting FilePath Executable FilePath
Lens' Executable FilePath
Cabal.modulePath

-- | Thin wrapper around 'discoverComponent' for test suites.
discoverTestSuite
    :: Applicative m
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> Cabal.TestSuite
    -> m Cabal.TestSuite
discoverTestSuite :: (FilePath -> m [FilePath]) -> TestSuite -> m TestSuite
discoverTestSuite = Lens' TestSuite [ModuleName]
-> (TestSuite -> [ModuleName])
-> (FilePath -> m [FilePath])
-> TestSuite
-> m TestSuite
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent forall a. HasBuildInfo a => Lens' a [ModuleName]
Lens' TestSuite [ModuleName]
Cabal.otherModules ((TestSuite -> [ModuleName])
 -> (FilePath -> m [FilePath]) -> TestSuite -> m TestSuite)
-> (TestSuite -> [ModuleName])
-> (FilePath -> m [FilePath])
-> TestSuite
-> m TestSuite
forall a b. (a -> b) -> a -> b
$ \TestSuite
ts ->
    case Getting TestSuiteInterface TestSuite TestSuiteInterface
-> TestSuite -> TestSuiteInterface
forall a s. Getting a s a -> s -> a
Lens.view Getting TestSuiteInterface TestSuite TestSuiteInterface
Lens' TestSuite TestSuiteInterface
Cabal.testInterface TestSuite
ts of
        TestSuiteInterface.TestSuiteExeV10 Version
_ FilePath
fp ->
            Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
Maybe.maybeToList (Maybe ModuleName -> [ModuleName])
-> Maybe ModuleName -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe ModuleName
filePathToModuleName FilePath
fp
        TestSuiteInterface.TestSuiteLibV09 Version
_ ModuleName
mn -> [ModuleName
mn]
        TestSuiteInterface.TestSuiteUnsupported TestType
_ -> []

-- | Thin wrapper around 'discoverComponent' for benchmarks.
discoverBenchmark
    :: Applicative m
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> Cabal.Benchmark
    -> m Cabal.Benchmark
discoverBenchmark :: (FilePath -> m [FilePath]) -> Benchmark -> m Benchmark
discoverBenchmark = Lens' Benchmark [ModuleName]
-> (Benchmark -> [ModuleName])
-> (FilePath -> m [FilePath])
-> Benchmark
-> m Benchmark
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent forall a. HasBuildInfo a => Lens' a [ModuleName]
Lens' Benchmark [ModuleName]
Cabal.otherModules ((Benchmark -> [ModuleName])
 -> (FilePath -> m [FilePath]) -> Benchmark -> m Benchmark)
-> (Benchmark -> [ModuleName])
-> (FilePath -> m [FilePath])
-> Benchmark
-> m Benchmark
forall a b. (a -> b) -> a -> b
$ \Benchmark
ts ->
    case Getting BenchmarkInterface Benchmark BenchmarkInterface
-> Benchmark -> BenchmarkInterface
forall a s. Getting a s a -> s -> a
Lens.view Getting BenchmarkInterface Benchmark BenchmarkInterface
Lens' Benchmark BenchmarkInterface
Cabal.benchmarkInterface Benchmark
ts of
        BenchmarkInterface.BenchmarkExeV10 Version
_ FilePath
fp ->
            Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
Maybe.maybeToList (Maybe ModuleName -> [ModuleName])
-> Maybe ModuleName -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe ModuleName
filePathToModuleName FilePath
fp
        BenchmarkInterface.BenchmarkUnsupported BenchmarkType
_ -> []

-- | Discovers modules in the given component, using the provided lens to
-- select which field to update. This is the main workhorse of the package.
discoverComponent
    :: (Cabal.HasBuildInfo a, Applicative m)
    => Lens.Lens' a [ModuleName.ModuleName]
    -- ^ Typically something like 'Cabal.exposedModules'.
    -> (a -> [ModuleName.ModuleName])
    -- ^ This function is used to get a list of module names to avoid
    -- discovering. For example if you're populating 'Cabal.exposedModules',
    -- then you'll want to use 'Cabal.otherModules' here to avoid discovering
    -- duplicates.
    -> (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> a
    -> m a
discoverComponent :: Lens' a [ModuleName]
-> (a -> [ModuleName]) -> (FilePath -> m [FilePath]) -> a -> m a
discoverComponent Lens' a [ModuleName]
includeL a -> [ModuleName]
toExclude FilePath -> m [FilePath]
f a
component =
    let
        velmaDiscover :: ModuleName
velmaDiscover =
            FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
"Velma.Discover" :: ModuleName.ModuleName
    in
        case ModuleName -> [ModuleName] -> Maybe [ModuleName]
forall a. Eq a => a -> [a] -> Maybe [a]
maybeRemove ModuleName
velmaDiscover ([ModuleName] -> Maybe [ModuleName])
-> [ModuleName] -> Maybe [ModuleName]
forall a b. (a -> b) -> a -> b
$ Getting [ModuleName] a [ModuleName] -> a -> [ModuleName]
forall a s. Getting a s a -> s -> a
Lens.view Getting [ModuleName] a [ModuleName]
Lens' a [ModuleName]
includeL a
component of
            Maybe [ModuleName]
Nothing -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
component
            Just [ModuleName]
include ->
                let
                    addDiscovered :: Set ModuleName -> a
addDiscovered Set ModuleName
discovered = ASetter a a [ModuleName] [ModuleName] -> [ModuleName] -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set
                        ASetter a a [ModuleName] [ModuleName]
Lens' a [ModuleName]
includeL
                        ([ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
ListUtils.nubOrd
                        ([ModuleName] -> [ModuleName])
-> ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Monoid a => a -> a -> a
mappend [ModuleName]
include
                        ([ModuleName] -> [ModuleName])
-> ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
Set.toAscList
                        (Set ModuleName -> [ModuleName])
-> ([ModuleName] -> Set ModuleName) -> [ModuleName] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set ModuleName
discovered
                        (Set ModuleName -> Set ModuleName)
-> ([ModuleName] -> Set ModuleName)
-> [ModuleName]
-> Set ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList
                        ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ a -> [ModuleName]
toExclude a
component
                        )
                        a
component
                in Set ModuleName -> a
addDiscovered (Set ModuleName -> a) -> m (Set ModuleName) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m [FilePath]) -> a -> m (Set ModuleName)
forall a (m :: * -> *).
(HasBuildInfo a, Applicative m) =>
(FilePath -> m [FilePath]) -> a -> m (Set ModuleName)
getModuleNames FilePath -> m [FilePath]
f a
component

-- | Gets module names for the given component, using the provided function to
-- list directory contents. This basically just glues together
-- 'getHsSourceDirs', 'listDirectoryRecursively', and 'filePathToModuleName'.
getModuleNames
    :: (Cabal.HasBuildInfo a, Applicative m)
    => (FilePath -> m [FilePath]) -- ^ See 'listDirectoryRecursively'.
    -> a
    -> m (Set.Set ModuleName.ModuleName)
getModuleNames :: (FilePath -> m [FilePath]) -> a -> m (Set ModuleName)
getModuleNames FilePath -> m [FilePath]
f =
    ([[FilePath]] -> Set ModuleName)
-> m [[FilePath]] -> m (Set ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName)
-> ([[FilePath]] -> [ModuleName]) -> [[FilePath]] -> Set ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe FilePath -> Maybe ModuleName
filePathToModuleName ([FilePath] -> [ModuleName])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat)
        (m [[FilePath]] -> m (Set ModuleName))
-> (a -> m [[FilePath]]) -> a -> m (Set ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> m [FilePath]) -> [FilePath] -> m [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\FilePath
d -> (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
FilePath.makeRelative FilePath
d) ([FilePath] -> [FilePath]) -> m [FilePath] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m [FilePath]
f FilePath
d)
        ([FilePath] -> m [[FilePath]])
-> (a -> [FilePath]) -> a -> m [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [FilePath]
forall a. HasBuildInfo a => a -> [FilePath]
getHsSourceDirs

-- | Gets @hs-source-dirs@ from the given component.
--
-- - If @hs-source-dirs@ isn't set (or is empty), this will return the inferred
-- directory, which is the current directory (@"."@).
-- - Duplicates are removed from the result using 'ListUtils.nubOrd'.
-- - This should probably return @SymbolicPath@ values, but that type was only
-- introduced in recent versions (>= 3.6) of Cabal.
getHsSourceDirs :: Cabal.HasBuildInfo a => a -> [FilePath]
getHsSourceDirs :: a -> [FilePath]
getHsSourceDirs =
    [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
ListUtils.nubOrd
        ([FilePath] -> [FilePath]) -> (a -> [FilePath]) -> a -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
withDefault [FilePath
"."]
        ([FilePath] -> [FilePath]) -> (a -> [FilePath]) -> a -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath PackageDir SourceDir -> FilePath
forall a b. SymbolicPath a b -> FilePath
SymbolicPath.toFilePath
        ([SymbolicPath PackageDir SourceDir] -> [FilePath])
-> (a -> [SymbolicPath PackageDir SourceDir]) -> a -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  [SymbolicPath PackageDir SourceDir]
  a
  [SymbolicPath PackageDir SourceDir]
-> a -> [SymbolicPath PackageDir SourceDir]
forall a s. Getting a s a -> s -> a
Lens.view Getting
  [SymbolicPath PackageDir SourceDir]
  a
  [SymbolicPath PackageDir SourceDir]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPath PackageDir SourceDir]
Cabal.hsSourceDirs

-- | Attempts to convert a 'FilePath' into a 'ModuleName.ModuleName'. This
-- works by stripping certain extensions, then converting directory separators
-- into module separators, and finally trying to parse that as a module name.
--
-- >>> filePathToModuleName "Velma.hs"
-- Just (ModuleName "Velma")
-- >>> filePathToModuleName "Velma/SymbolicPath.hs"
-- Just (ModuleName "Velma.SymbolicPath")
-- >>> filePathToModuleName "README.markdown"
-- Nothing
-- >>> filePathToModuleName "library/Velma.hs"
-- Nothing
filePathToModuleName :: FilePath -> Maybe ModuleName.ModuleName
filePathToModuleName :: FilePath -> Maybe ModuleName
filePathToModuleName FilePath
filePath = do
    FilePath
base <- FilePath -> FilePath -> Maybe FilePath
FilePath.stripExtension FilePath
"hs" FilePath
filePath
    FilePath -> Maybe ModuleName
forall a. Parsec a => FilePath -> Maybe a
Parsec.simpleParsec (FilePath -> Maybe ModuleName)
-> ([FilePath] -> FilePath) -> [FilePath] -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"." ([FilePath] -> Maybe ModuleName) -> [FilePath] -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
FilePath.splitDirectories FilePath
base

-- | Lists all of the directory contents recursively. The returned file paths
-- will include the directory prefix, unlike 'Directory.listDirectory'. For
-- example:
--
-- >>> listDirectoryRecursively "source/library"
-- ["source/library/Velma.hs","source/library/Velma/SymbolicPath.hs"]
listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
directory = do
    let
        helper :: FilePath -> IO [FilePath]
helper FilePath
filePath = do
            Bool
isDirectory <- FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
filePath
            if Bool
isDirectory
                then FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
filePath
                else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
filePath]
    [FilePath]
entries <- FilePath -> IO [FilePath]
Directory.listDirectory FilePath
directory
    [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath -> IO [FilePath]
helper (FilePath -> IO [FilePath])
-> (FilePath -> FilePath) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
FilePath.combine FilePath
directory) [FilePath]
entries

-- | Applies all of the functions left-to-right using '(Monad.>=>)'.
--
-- >>> let printAnd f x = do { putStrLn $ "x = " <> show x; pure $ f x }
-- >>> concatM [ printAnd (+ 2), printAnd (* 2) ] 3
-- x = 3
-- x = 5
-- 10
concatM :: Monad m => [a -> m a] -> a -> m a
concatM :: [a -> m a] -> a -> m a
concatM = ((a -> m a) -> (a -> m a) -> a -> m a)
-> (a -> m a) -> [a -> m a] -> a -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(Monad.>=>) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | A lens for the 'CondTree.condTreeData' field.
condTreeData :: Lens.Lens' (CondTree.CondTree v c a) a
condTreeData :: LensLike f (CondTree v c a) (CondTree v c a) a a
condTreeData a -> f a
f CondTree v c a
ct =
    (a -> CondTree v c a) -> f a -> f (CondTree v c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
d -> CondTree v c a
ct { condTreeData :: a
CondTree.condTreeData = a
d }) (f a -> f (CondTree v c a))
-> (a -> f a) -> a -> f (CondTree v c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
f (a -> f (CondTree v c a)) -> a -> f (CondTree v c a)
forall a b. (a -> b) -> a -> b
$ CondTree v c a -> a
forall v c a. CondTree v c a -> a
CondTree.condTreeData
        CondTree v c a
ct

-- | Attempts to remove an element from the list. If it succeeds, returns the
-- list without that element. If it fails, returns 'Nothing'.
--
-- >>> maybeRemove 'b' "abc"
-- Just "ac"
-- >>> maybeRemove 'z' "abc"
-- Nothing
--
-- Note that only the first matching element is removed.
--
-- >>> maybeRemove 'b' "abcb"
-- Just "acb"
maybeRemove :: Eq a => a -> [a] -> Maybe [a]
maybeRemove :: a -> [a] -> Maybe [a]
maybeRemove a
x [a]
ys = case [a]
ys of
    [] -> Maybe [a]
forall a. Maybe a
Nothing
    a
y : [a]
zs -> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
zs else (:) a
y ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a] -> Maybe [a]
forall a. Eq a => a -> [a] -> Maybe [a]
maybeRemove a
x [a]
zs

-- | Like 'Lens.over' except the modification function can perform arbitrary
-- effects.
--
-- >>> overF _2 (Just . (+ 2)) ('a', 3)
-- Just ('a',5)
-- >>> overF _2 (const Nothing) ('a', 3)
-- Nothing
overF :: Functor f => Lens.Lens' s a -> (a -> f a) -> s -> f s
overF :: Lens' s a -> (a -> f a) -> s -> f s
overF Lens' s a
l a -> f a
f s
x = (\a
y -> ASetter s s a a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter s s a a
Lens' s a
l a
y s
x) (a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f (Getting a s a -> s -> a
forall a s. Getting a s a -> s -> a
Lens.view Getting a s a
Lens' s a
l s
x)

-- | Returns the given default value if the other value is 'null'. For example:
--
-- >>> withDefault ["default"] []
-- ["default"]
-- >>> withDefault ["default"] ["something"]
-- ["something"]
withDefault
    :: Foldable t
    => t a -- ^ The default value.
    -> t a
    -> t a
withDefault :: t a -> t a -> t a
withDefault t a
d t a
x = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then t a
d else t a
x