{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Symbols (
	-- * Utility
	locateProject, searchProject,
	locateSourceDir,
	standaloneInfo,
	moduleOpts, projectTargetOpts,

	-- * Tags
	setTag, hasTag, removeTag, dropTags,
	inspectTag, inspectUntag,

	-- * Reexportss
	module HsDev.Symbols.Types,
	module HsDev.Symbols.Class,
	module HsDev.Symbols.Documented,
	module HsDev.Symbols.HaskellNames
	) where

import Control.Applicative
import Control.Lens
import Control.Monad.Trans.Maybe
import Control.Monad.Except
import Control.Monad.State
import Data.List
import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import System.Directory
import System.FilePath

import HsDev.Symbols.Types
import HsDev.Symbols.Class
import HsDev.Symbols.Documented (Documented(..))
import HsDev.Symbols.HaskellNames
import HsDev.Util (searchPath, uniqueBy, directoryContents)
import System.Directory.Paths

-- | Find project file is related to
locateProject :: FilePath -> IO (Maybe Project)
locateProject :: FilePath -> IO (Maybe Project)
locateProject FilePath
file = do
	FilePath
file' <- FilePath -> IO FilePath
canonicalizePath FilePath
file
	Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
file'
	if Bool
isDir then FilePath -> IO (Maybe Project)
locateHere FilePath
file' else FilePath -> IO (Maybe Project)
locateParent (FilePath -> FilePath
takeDirectory FilePath
file')
	where
		locateHere :: FilePath -> IO (Maybe Project)
locateHere FilePath
p = do
			[FilePath]
cts <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeBaseName) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
directoryContents FilePath
p
			Maybe Project -> IO (Maybe Project)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Project -> IO (Maybe Project))
-> Maybe Project -> IO (Maybe Project)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Project) -> Maybe FilePath -> Maybe Project
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Project
project (FilePath -> Project)
-> (FilePath -> FilePath) -> FilePath -> Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
p FilePath -> FilePath -> FilePath
</>)) (Maybe FilePath -> Maybe Project)
-> Maybe FilePath -> Maybe Project
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
cts
		locateParent :: FilePath -> IO (Maybe Project)
locateParent FilePath
dir = do
			[FilePath]
cts <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeBaseName) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
directoryContents FilePath
dir
			case (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
cts of
				Maybe FilePath
Nothing -> if FilePath -> Bool
isDrive FilePath
dir then Maybe Project -> IO (Maybe Project)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Project
forall a. Maybe a
Nothing else FilePath -> IO (Maybe Project)
locateParent (FilePath -> FilePath
takeDirectory FilePath
dir)
				Just FilePath
cabalf -> Maybe Project -> IO (Maybe Project)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Project -> IO (Maybe Project))
-> Maybe Project -> IO (Maybe Project)
forall a b. (a -> b) -> a -> b
$ Project -> Maybe Project
forall a. a -> Maybe a
Just (Project -> Maybe Project) -> Project -> Maybe Project
forall a b. (a -> b) -> a -> b
$ FilePath -> Project
project (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
cabalf)

-- | Search project up
searchProject :: FilePath -> IO (Maybe Project)
searchProject :: FilePath -> IO (Maybe Project)
searchProject FilePath
file = MaybeT IO Project -> IO (Maybe Project)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Project -> IO (Maybe Project))
-> MaybeT IO Project -> IO (Maybe Project)
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> MaybeT IO Project) -> MaybeT IO Project
forall (m :: * -> *) a.
(MonadIO m, MonadPlus m) =>
FilePath -> (FilePath -> m a) -> m a
searchPath FilePath
file (IO (Maybe Project) -> MaybeT IO Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Project) -> MaybeT IO Project)
-> (FilePath -> IO (Maybe Project))
-> FilePath
-> MaybeT IO Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe Project)
locateProject) MaybeT IO Project -> MaybeT IO Project -> MaybeT IO Project
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT IO Project
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Locate source dir of file
locateSourceDir :: FilePath -> IO (Maybe (Extensions Path))
locateSourceDir :: FilePath -> IO (Maybe (Extensions Path))
locateSourceDir FilePath
f = MaybeT IO (Extensions Path) -> IO (Maybe (Extensions Path))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Extensions Path) -> IO (Maybe (Extensions Path)))
-> MaybeT IO (Extensions Path) -> IO (Maybe (Extensions Path))
forall a b. (a -> b) -> a -> b
$ do
	FilePath
file <- IO FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> MaybeT IO FilePath)
-> IO FilePath -> MaybeT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
f
	Project
p <- IO (Maybe Project) -> MaybeT IO Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Project) -> MaybeT IO Project)
-> IO (Maybe Project) -> MaybeT IO Project
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe Project)
locateProject FilePath
file
	Project
proj <- IO Project -> MaybeT IO Project
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Project -> MaybeT IO Project)
-> IO Project -> MaybeT IO Project
forall a b. (a -> b) -> a -> b
$ Project -> IO Project
loadProject Project
p
	IO (Maybe (Extensions Path)) -> MaybeT IO (Extensions Path)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Extensions Path)) -> MaybeT IO (Extensions Path))
-> IO (Maybe (Extensions Path)) -> MaybeT IO (Extensions Path)
forall a b. (a -> b) -> a -> b
$ Maybe (Extensions Path) -> IO (Maybe (Extensions Path))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Extensions Path) -> IO (Maybe (Extensions Path)))
-> Maybe (Extensions Path) -> IO (Maybe (Extensions Path))
forall a b. (a -> b) -> a -> b
$ Project -> Path -> Maybe (Extensions Path)
findSourceDir Project
proj (FilePath -> Path
fromFilePath FilePath
file)

-- | Make `Info` for standalone `Module`
standaloneInfo :: [PackageConfig] -> Module -> Info
standaloneInfo :: [PackageConfig] -> Module -> Info
standaloneInfo [PackageConfig]
pkgs Module
m = Info
forall a. Monoid a => a
mempty { _infoDepends :: [Path]
_infoDepends = [PackageConfig]
pkgDeps [PackageConfig]
-> Getting (Endo [Path]) [PackageConfig] Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (PackageConfig -> Const (Endo [Path]) PackageConfig)
-> [PackageConfig] -> Const (Endo [Path]) [PackageConfig]
forall s t a b. Each s t a b => Traversal s t a b
each ((PackageConfig -> Const (Endo [Path]) PackageConfig)
 -> [PackageConfig] -> Const (Endo [Path]) [PackageConfig])
-> ((Path -> Const (Endo [Path]) Path)
    -> PackageConfig -> Const (Endo [Path]) PackageConfig)
-> Getting (Endo [Path]) [PackageConfig] Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (Endo [Path]) ModulePackage)
-> PackageConfig -> Const (Endo [Path]) PackageConfig
Lens' PackageConfig ModulePackage
package ((ModulePackage -> Const (Endo [Path]) ModulePackage)
 -> PackageConfig -> Const (Endo [Path]) PackageConfig)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModulePackage -> Const (Endo [Path]) ModulePackage)
-> (Path -> Const (Endo [Path]) Path)
-> PackageConfig
-> Const (Endo [Path]) PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> ModulePackage -> Const (Endo [Path]) ModulePackage
Lens' ModulePackage Path
packageName } where
	pkgDeps :: [PackageConfig]
pkgDeps = [Maybe PackageConfig] -> [PackageConfig]
forall a. [Maybe a] -> [a]
catMaybes [Path -> Map Path [PackageConfig] -> Maybe [PackageConfig]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Path
mdep Map Path [PackageConfig]
pkgMap Maybe [PackageConfig]
-> ([PackageConfig] -> Maybe PackageConfig) -> Maybe PackageConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [PackageConfig] -> Maybe PackageConfig
forall a. [a] -> Maybe a
listToMaybe | Path
mdep <- Path
"Prelude" Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
imps]
	pkgMap :: Map Path [PackageConfig]
pkgMap = ([PackageConfig] -> [PackageConfig] -> [PackageConfig])
-> [Map Path [PackageConfig]] -> Map Path [PackageConfig]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [PackageConfig] -> [PackageConfig] -> [PackageConfig]
mergePkgs [Path -> [PackageConfig] -> Map Path [PackageConfig]
forall k a. k -> a -> Map k a
M.singleton Path
m' [PackageConfig
p] | PackageConfig
p <- [PackageConfig]
pkgs, Path
m' <- Getting [Path] PackageConfig [Path] -> PackageConfig -> [Path]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Path] PackageConfig [Path]
Lens' PackageConfig [Path]
packageModules PackageConfig
p]
	mergePkgs :: [PackageConfig] -> [PackageConfig] -> [PackageConfig]
mergePkgs [PackageConfig]
ls [PackageConfig]
rs = if [PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
es then [PackageConfig]
hs else [PackageConfig]
es where
		([PackageConfig]
es, [PackageConfig]
hs) = (PackageConfig -> Bool)
-> [PackageConfig] -> ([PackageConfig], [PackageConfig])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Getting Bool PackageConfig Bool -> PackageConfig -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool PackageConfig Bool
Lens' PackageConfig Bool
packageExposed) ([PackageConfig] -> ([PackageConfig], [PackageConfig]))
-> [PackageConfig] -> ([PackageConfig], [PackageConfig])
forall a b. (a -> b) -> a -> b
$ (PackageConfig -> ModulePackage)
-> [PackageConfig] -> [PackageConfig]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqueBy (Getting ModulePackage PackageConfig ModulePackage
-> PackageConfig -> ModulePackage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModulePackage PackageConfig ModulePackage
Lens' PackageConfig ModulePackage
package) ([PackageConfig]
ls [PackageConfig] -> [PackageConfig] -> [PackageConfig]
forall a. [a] -> [a] -> [a]
++ [PackageConfig]
rs)
	imps :: [Path]
imps = Path -> [Path] -> [Path]
forall a. Eq a => a -> [a] -> [a]
delete (Getting Path Module Path -> Module -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ModuleId -> Const Path ModuleId) -> Module -> Const Path Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const Path ModuleId) -> Module -> Const Path Module)
-> ((Path -> Const Path Path) -> ModuleId -> Const Path ModuleId)
-> Getting Path Module Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path) -> ModuleId -> Const Path ModuleId
Lens' ModuleId Path
moduleName) Module
m) (Module
m Module -> Getting (Endo [Path]) Module Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Import] -> Const (Endo [Path]) [Import])
-> Module -> Const (Endo [Path]) Module
Lens' Module [Import]
moduleImports (([Import] -> Const (Endo [Path]) [Import])
 -> Module -> Const (Endo [Path]) Module)
-> ((Path -> Const (Endo [Path]) Path)
    -> [Import] -> Const (Endo [Path]) [Import])
-> Getting (Endo [Path]) Module Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Import -> Const (Endo [Path]) Import)
-> [Import] -> Const (Endo [Path]) [Import]
forall s t a b. Each s t a b => Traversal s t a b
each ((Import -> Const (Endo [Path]) Import)
 -> [Import] -> Const (Endo [Path]) [Import])
-> ((Path -> Const (Endo [Path]) Path)
    -> Import -> Const (Endo [Path]) Import)
-> (Path -> Const (Endo [Path]) Path)
-> [Import]
-> Const (Endo [Path]) [Import]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> Import -> Const (Endo [Path]) Import
Lens' Import Path
importName)

-- | Options for GHC of module and project
moduleOpts :: [PackageConfig] -> Module -> [String]
moduleOpts :: [PackageConfig] -> Module -> [FilePath]
moduleOpts [PackageConfig]
pkgs Module
m = case Getting ModuleLocation Module ModuleLocation
-> Module -> ModuleLocation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ModuleId -> Const ModuleLocation ModuleId)
-> Module -> Const ModuleLocation Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const ModuleLocation ModuleId)
 -> Module -> Const ModuleLocation Module)
-> ((ModuleLocation -> Const ModuleLocation ModuleLocation)
    -> ModuleId -> Const ModuleLocation ModuleId)
-> Getting ModuleLocation Module ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const ModuleLocation ModuleLocation)
-> ModuleId -> Const ModuleLocation ModuleId
Lens' ModuleId ModuleLocation
moduleLocation) Module
m of
	FileModule Path
file Maybe Project
proj -> [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
		[FilePath]
hidePackages,
		Info -> [FilePath]
targetOpts Info
absInfo]
		where
			infos' :: [Info]
infos' = [Info] -> (Project -> [Info]) -> Maybe Project -> [Info]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[PackageConfig] -> Module -> Info
standaloneInfo [PackageConfig]
pkgs Module
m] (Project -> Path -> [Info]
`fileTargets` Path
file) Maybe Project
proj
			info' :: Info
info' = ASetter Info Info [Path] [Path]
-> ([Path] -> [Path]) -> Info -> Info
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Info Info [Path] [Path]
Lens' Info [Path]
infoDepends ((Path -> Bool) -> [Path] -> [Path]
forall a. (a -> Bool) -> [a] -> [a]
filter Path -> Bool
validDep) ([Info] -> Info
forall a. Monoid a => [a] -> a
mconcat ([Info] -> Info) -> [Info] -> Info
forall a b. (a -> b) -> a -> b
$ Info
selfInfo Info -> [Info] -> [Info]
forall a. a -> [a] -> [a]
: [Info]
infos')
			absInfo :: Info
absInfo = (Info -> Info)
-> (Project -> Info -> Info) -> Maybe Project -> Info -> Info
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Info -> Info
forall a. a -> a
id (Path -> Info -> Info
forall a. Paths a => Path -> a -> a
absolutise (Path -> Info -> Info)
-> (Project -> Path) -> Project -> Info -> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Path Project Path -> Project -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Path Project Path
Lens' Project Path
projectPath) Maybe Project
proj Info
info'
			selfInfo :: Info
selfInfo
				| Maybe Project
proj Maybe Project
-> Getting (First Path) (Maybe Project) Path -> Maybe Path
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Project -> Const (First Path) Project)
-> Maybe Project -> Const (First Path) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Project -> Const (First Path) Project)
 -> Maybe Project -> Const (First Path) (Maybe Project))
-> ((Path -> Const (First Path) Path)
    -> Project -> Const (First Path) Project)
-> Getting (First Path) (Maybe Project) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> Project -> Const (First Path) Project
Lens' Project Path
projectName Maybe Path -> [Maybe Path] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Path -> Maybe Path) -> [Path] -> [Maybe Path]
forall a b. (a -> b) -> [a] -> [b]
map Path -> Maybe Path
forall a. a -> Maybe a
Just ([Info]
infos' [Info] -> Getting (Endo [Path]) [Info] Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Info -> Const (Endo [Path]) Info)
-> [Info] -> Const (Endo [Path]) [Info]
forall s t a b. Each s t a b => Traversal s t a b
each ((Info -> Const (Endo [Path]) Info)
 -> [Info] -> Const (Endo [Path]) [Info])
-> ((Path -> Const (Endo [Path]) Path)
    -> Info -> Const (Endo [Path]) Info)
-> Getting (Endo [Path]) [Info] Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path] -> Const (Endo [Path]) [Path])
-> Info -> Const (Endo [Path]) Info
Lens' Info [Path]
infoDepends (([Path] -> Const (Endo [Path]) [Path])
 -> Info -> Const (Endo [Path]) Info)
-> ((Path -> Const (Endo [Path]) Path)
    -> [Path] -> Const (Endo [Path]) [Path])
-> (Path -> Const (Endo [Path]) Path)
-> Info
-> Const (Endo [Path]) Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> [Path] -> Const (Endo [Path]) [Path]
forall s t a b. Each s t a b => Traversal s t a b
each) = Info -> Maybe Info -> Info
forall a. a -> Maybe a -> a
fromMaybe Info
forall a. Monoid a => a
mempty (Maybe Info -> Info) -> Maybe Info -> Info
forall a b. (a -> b) -> a -> b
$
					Maybe Project
proj Maybe Project
-> Getting (First Info) (Maybe Project) Info -> Maybe Info
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Project -> Const (First Info) Project)
-> Maybe Project -> Const (First Info) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Project -> Const (First Info) Project)
 -> Maybe Project -> Const (First Info) (Maybe Project))
-> ((Info -> Const (First Info) Info)
    -> Project -> Const (First Info) Project)
-> Getting (First Info) (Maybe Project) Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProjectDescription
 -> Const (First Info) (Maybe ProjectDescription))
-> Project -> Const (First Info) Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const (First Info) (Maybe ProjectDescription))
 -> Project -> Const (First Info) Project)
-> ((Info -> Const (First Info) Info)
    -> Maybe ProjectDescription
    -> Const (First Info) (Maybe ProjectDescription))
-> (Info -> Const (First Info) Info)
-> Project
-> Const (First Info) Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Const (First Info) ProjectDescription)
-> Maybe ProjectDescription
-> Const (First Info) (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Const (First Info) ProjectDescription)
 -> Maybe ProjectDescription
 -> Const (First Info) (Maybe ProjectDescription))
-> ((Info -> Const (First Info) Info)
    -> ProjectDescription -> Const (First Info) ProjectDescription)
-> (Info -> Const (First Info) Info)
-> Maybe ProjectDescription
-> Const (First Info) (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Library -> Const (First Info) (Maybe Library))
-> ProjectDescription -> Const (First Info) ProjectDescription
Lens' ProjectDescription (Maybe Library)
projectLibrary ((Maybe Library -> Const (First Info) (Maybe Library))
 -> ProjectDescription -> Const (First Info) ProjectDescription)
-> ((Info -> Const (First Info) Info)
    -> Maybe Library -> Const (First Info) (Maybe Library))
-> (Info -> Const (First Info) Info)
-> ProjectDescription
-> Const (First Info) ProjectDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (First Info) Library)
-> Maybe Library -> Const (First Info) (Maybe Library)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Library -> Const (First Info) Library)
 -> Maybe Library -> Const (First Info) (Maybe Library))
-> ((Info -> Const (First Info) Info)
    -> Library -> Const (First Info) Library)
-> (Info -> Const (First Info) Info)
-> Maybe Library
-> Const (First Info) (Maybe Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Info -> Const (First Info) Info)
-> Library -> Const (First Info) Library
Lens' Library Info
libraryBuildInfo
				| Bool
otherwise = Info
forall a. Monoid a => a
mempty
			-- filter out unavailable packages such as unix under windows
			validDep :: Path -> Bool
validDep Path
d = Path
d Path -> [Path] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path]
pkgs'
			pkgs' :: [Path]
pkgs' = [PackageConfig]
pkgs [PackageConfig]
-> Getting (Endo [Path]) [PackageConfig] Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (PackageConfig -> Const (Endo [Path]) PackageConfig)
-> [PackageConfig] -> Const (Endo [Path]) [PackageConfig]
forall s t a b. Each s t a b => Traversal s t a b
each ((PackageConfig -> Const (Endo [Path]) PackageConfig)
 -> [PackageConfig] -> Const (Endo [Path]) [PackageConfig])
-> ((Path -> Const (Endo [Path]) Path)
    -> PackageConfig -> Const (Endo [Path]) PackageConfig)
-> Getting (Endo [Path]) [PackageConfig] Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (Endo [Path]) ModulePackage)
-> PackageConfig -> Const (Endo [Path]) PackageConfig
Lens' PackageConfig ModulePackage
package ((ModulePackage -> Const (Endo [Path]) ModulePackage)
 -> PackageConfig -> Const (Endo [Path]) PackageConfig)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModulePackage -> Const (Endo [Path]) ModulePackage)
-> (Path -> Const (Endo [Path]) Path)
-> PackageConfig
-> Const (Endo [Path]) PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> ModulePackage -> Const (Endo [Path]) ModulePackage
Lens' ModulePackage Path
packageName
			hidePackages :: [FilePath]
hidePackages
				| [Path] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Info
info' Info -> Getting [Path] Info [Path] -> [Path]
forall s a. s -> Getting a s a -> a
^. Getting [Path] Info [Path]
Lens' Info [Path]
infoDepends) = []
				| Bool
otherwise = [FilePath
"-hide-all-packages"]
	ModuleLocation
_ -> []

-- | Options for GHC of project
projectTargetOpts :: [PackageConfig] -> Project -> Info -> [String]
projectTargetOpts :: [PackageConfig] -> Project -> Info -> [FilePath]
projectTargetOpts [PackageConfig]
pkgs Project
proj Info
info = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]
hidePackages, Info -> [FilePath]
targetOpts Info
absInfo] where
	info' :: Info
info' = ASetter Info Info [Path] [Path]
-> ([Path] -> [Path]) -> Info -> Info
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Info Info [Path] [Path]
Lens' Info [Path]
infoDepends ((Path -> Bool) -> [Path] -> [Path]
forall a. (a -> Bool) -> [a] -> [a]
filter Path -> Bool
validDep) (Info
selfInfo Info -> Info -> Info
forall a. Monoid a => a -> a -> a
`mappend` Info
info)
	absInfo :: Info
absInfo = Path -> Info -> Info
forall a. Paths a => Path -> a -> a
absolutise (Getting Path Project Path -> Project -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Path Project Path
Lens' Project Path
projectPath Project
proj) Info
info'
	selfInfo :: Info
selfInfo
		| Project
proj Project -> Getting Path Project Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path Project Path
Lens' Project Path
projectName Path -> [Path] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Info
info Info
-> ((Path -> Const (Endo [Path]) Path)
    -> Info -> Const (Endo [Path]) Info)
-> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Path] -> Const (Endo [Path]) [Path])
-> Info -> Const (Endo [Path]) Info
Lens' Info [Path]
infoDepends (([Path] -> Const (Endo [Path]) [Path])
 -> Info -> Const (Endo [Path]) Info)
-> ((Path -> Const (Endo [Path]) Path)
    -> [Path] -> Const (Endo [Path]) [Path])
-> (Path -> Const (Endo [Path]) Path)
-> Info
-> Const (Endo [Path]) Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> [Path] -> Const (Endo [Path]) [Path]
forall s t a b. Each s t a b => Traversal s t a b
each) = Info -> Maybe Info -> Info
forall a. a -> Maybe a -> a
fromMaybe Info
forall a. Monoid a => a
mempty (Maybe Info -> Info) -> Maybe Info -> Info
forall a b. (a -> b) -> a -> b
$
			Project
proj Project
-> ((Info -> Const (First Info) Info)
    -> Project -> Const (First Info) Project)
-> Maybe Info
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe ProjectDescription
 -> Const (First Info) (Maybe ProjectDescription))
-> Project -> Const (First Info) Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const (First Info) (Maybe ProjectDescription))
 -> Project -> Const (First Info) Project)
-> ((Info -> Const (First Info) Info)
    -> Maybe ProjectDescription
    -> Const (First Info) (Maybe ProjectDescription))
-> (Info -> Const (First Info) Info)
-> Project
-> Const (First Info) Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Const (First Info) ProjectDescription)
-> Maybe ProjectDescription
-> Const (First Info) (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Const (First Info) ProjectDescription)
 -> Maybe ProjectDescription
 -> Const (First Info) (Maybe ProjectDescription))
-> ((Info -> Const (First Info) Info)
    -> ProjectDescription -> Const (First Info) ProjectDescription)
-> (Info -> Const (First Info) Info)
-> Maybe ProjectDescription
-> Const (First Info) (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Library -> Const (First Info) (Maybe Library))
-> ProjectDescription -> Const (First Info) ProjectDescription
Lens' ProjectDescription (Maybe Library)
projectLibrary ((Maybe Library -> Const (First Info) (Maybe Library))
 -> ProjectDescription -> Const (First Info) ProjectDescription)
-> ((Info -> Const (First Info) Info)
    -> Maybe Library -> Const (First Info) (Maybe Library))
-> (Info -> Const (First Info) Info)
-> ProjectDescription
-> Const (First Info) ProjectDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (First Info) Library)
-> Maybe Library -> Const (First Info) (Maybe Library)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Library -> Const (First Info) Library)
 -> Maybe Library -> Const (First Info) (Maybe Library))
-> ((Info -> Const (First Info) Info)
    -> Library -> Const (First Info) Library)
-> (Info -> Const (First Info) Info)
-> Maybe Library
-> Const (First Info) (Maybe Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Info -> Const (First Info) Info)
-> Library -> Const (First Info) Library
Lens' Library Info
libraryBuildInfo
		| Bool
otherwise = Info
forall a. Monoid a => a
mempty
	validDep :: Path -> Bool
validDep Path
d = Path
d Path -> [Path] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path]
pkgs'
	pkgs' :: [Path]
pkgs' = [PackageConfig]
pkgs [PackageConfig]
-> Getting (Endo [Path]) [PackageConfig] Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (PackageConfig -> Const (Endo [Path]) PackageConfig)
-> [PackageConfig] -> Const (Endo [Path]) [PackageConfig]
forall s t a b. Each s t a b => Traversal s t a b
each ((PackageConfig -> Const (Endo [Path]) PackageConfig)
 -> [PackageConfig] -> Const (Endo [Path]) [PackageConfig])
-> ((Path -> Const (Endo [Path]) Path)
    -> PackageConfig -> Const (Endo [Path]) PackageConfig)
-> Getting (Endo [Path]) [PackageConfig] Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (Endo [Path]) ModulePackage)
-> PackageConfig -> Const (Endo [Path]) PackageConfig
Lens' PackageConfig ModulePackage
package ((ModulePackage -> Const (Endo [Path]) ModulePackage)
 -> PackageConfig -> Const (Endo [Path]) PackageConfig)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModulePackage -> Const (Endo [Path]) ModulePackage)
-> (Path -> Const (Endo [Path]) Path)
-> PackageConfig
-> Const (Endo [Path]) PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> ModulePackage -> Const (Endo [Path]) ModulePackage
Lens' ModulePackage Path
packageName
	hidePackages :: [FilePath]
hidePackages
		| [Path] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Info
info' Info -> Getting [Path] Info [Path] -> [Path]
forall s a. s -> Getting a s a -> a
^. Getting [Path] Info [Path]
Lens' Info [Path]
infoDepends) = []
		| Bool
otherwise = [FilePath
"-hide-all-packages"]

-- | Set tag to `Inspected`
setTag :: Ord t => t -> Inspected i t a -> Inspected i t a
setTag :: t -> Inspected i t a -> Inspected i t a
setTag t
tag' = ASetter (Inspected i t a) (Inspected i t a) (Set t) (Set t)
-> (Set t -> Set t) -> Inspected i t a -> Inspected i t a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Inspected i t a) (Inspected i t a) (Set t) (Set t)
forall k t1 a t2.
Lens (Inspected k t1 a) (Inspected k t2 a) (Set t1) (Set t2)
inspectionTags (t -> Set t -> Set t
forall a. Ord a => a -> Set a -> Set a
S.insert t
tag')

-- | Check whether `Inspected` has tag
hasTag :: Ord t => t -> Inspected i t a -> Bool
hasTag :: t -> Inspected i t a -> Bool
hasTag t
tag' = Getting Any (Inspected i t a) () -> Inspected i t a -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Set t -> Const Any (Set t))
-> Inspected i t a -> Const Any (Inspected i t a)
forall k t1 a t2.
Lens (Inspected k t1 a) (Inspected k t2 a) (Set t1) (Set t2)
inspectionTags ((Set t -> Const Any (Set t))
 -> Inspected i t a -> Const Any (Inspected i t a))
-> ((() -> Const Any ()) -> Set t -> Const Any (Set t))
-> Getting Any (Inspected i t a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set t) -> Traversal' (Set t) (IxValue (Set t))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix t
Index (Set t)
tag')

-- | Drop tag from `Inspected`
removeTag :: Ord t => t -> Inspected i t a -> Inspected i t a
removeTag :: t -> Inspected i t a -> Inspected i t a
removeTag t
tag' = ASetter (Inspected i t a) (Inspected i t a) (Set t) (Set t)
-> (Set t -> Set t) -> Inspected i t a -> Inspected i t a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Inspected i t a) (Inspected i t a) (Set t) (Set t)
forall k t1 a t2.
Lens (Inspected k t1 a) (Inspected k t2 a) (Set t1) (Set t2)
inspectionTags (t -> Set t -> Set t
forall a. Ord a => a -> Set a -> Set a
S.delete t
tag')

-- | Drop all tags
dropTags :: Inspected i t a -> Inspected i t a
dropTags :: Inspected i t a -> Inspected i t a
dropTags = ASetter (Inspected i t a) (Inspected i t a) (Set t) (Set t)
-> Set t -> Inspected i t a -> Inspected i t a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Inspected i t a) (Inspected i t a) (Set t) (Set t)
forall k t1 a t2.
Lens (Inspected k t1 a) (Inspected k t2 a) (Set t1) (Set t2)
inspectionTags Set t
forall a. Set a
S.empty

-- | Set inspection tag
inspectTag :: (Monad m, Ord t) => t -> InspectM k t m a -> InspectM k t m a
inspectTag :: t -> InspectM k t m a -> InspectM k t m a
inspectTag t
tag' InspectM k t m a
act = InspectM k t m a
act InspectM k t m a -> InspectM k t m () -> InspectM k t m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Inspection, Set t) -> (Inspection, Set t)) -> InspectM k t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter (Inspection, Set t) (Inspection, Set t) (Set t) (Set t)
-> (Set t -> Set t) -> (Inspection, Set t) -> (Inspection, Set t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Inspection, Set t) (Inspection, Set t) (Set t) (Set t)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (t -> Set t -> Set t
forall a. Ord a => a -> Set a -> Set a
S.insert t
tag'))

-- | Unser inspection tag
inspectUntag :: (Monad m, Ord t) => t -> InspectM k t m a -> InspectM k t m a
inspectUntag :: t -> InspectM k t m a -> InspectM k t m a
inspectUntag t
tag' InspectM k t m a
act = InspectM k t m a
act InspectM k t m a -> InspectM k t m () -> InspectM k t m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Inspection, Set t) -> (Inspection, Set t)) -> InspectM k t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter (Inspection, Set t) (Inspection, Set t) (Set t) (Set t)
-> (Set t -> Set t) -> (Inspection, Set t) -> (Inspection, Set t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Inspection, Set t) (Inspection, Set t) (Set t) (Set t)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (t -> Set t -> Set t
forall a. Ord a => a -> Set a -> Set a
S.delete t
tag'))