{-# 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 file = do
	file' <- canonicalizePath file
	isDir <- doesDirectoryExist file'
	if isDir then locateHere file' else locateParent (takeDirectory file')
	where
		locateHere p = do
			cts <- filter (not . null . takeBaseName) <$> directoryContents p
			return $ fmap (project . (p </>)) $ find ((== ".cabal") . takeExtension) cts
		locateParent dir = do
			cts <- filter (not . null . takeBaseName) <$> directoryContents dir
			case find ((== ".cabal") . takeExtension) cts of
				Nothing -> if isDrive dir then return Nothing else locateParent (takeDirectory dir)
				Just cabalf -> return $ Just $ project (dir </> cabalf)

-- | Search project up
searchProject :: FilePath -> IO (Maybe Project)
searchProject file = runMaybeT $ searchPath file (MaybeT . locateProject) <|> mzero

-- | Locate source dir of file
locateSourceDir :: FilePath -> IO (Maybe (Extensions Path))
locateSourceDir f = runMaybeT $ do
	file <- liftIO $ canonicalizePath f
	p <- MaybeT $ locateProject file
	proj <- lift $ loadProject p
	MaybeT $ return $ findSourceDir proj (fromFilePath file)

-- | Make `Info` for standalone `Module`
standaloneInfo :: [PackageConfig] -> Module -> Info
standaloneInfo pkgs m = mempty { _infoDepends = pkgDeps ^.. each . package . packageName } where
	pkgDeps = catMaybes [M.lookup mdep pkgMap >>= listToMaybe | mdep <- "Prelude" : imps]
	pkgMap = M.unionsWith mergePkgs [M.singleton m' [p] | p <- pkgs, m' <- view packageModules p]
	mergePkgs ls rs = if null es then hs else es where
		(es, hs) = partition (view packageExposed) $ uniqueBy (view package) (ls ++ rs)
	imps = delete (view (moduleId . moduleName) m) (m ^.. moduleImports . each . importName)

-- | Options for GHC of module and project
moduleOpts :: [PackageConfig] -> Module -> [String]
moduleOpts pkgs m = case view (moduleId . moduleLocation) m of
	FileModule file proj -> concat [
		hidePackages,
		targetOpts absInfo]
		where
			infos' = maybe [standaloneInfo pkgs m] (`fileTargets` file) proj
			info' = over infoDepends (filter validDep) (mconcat $ selfInfo : infos')
			absInfo = maybe id (absolutise . view projectPath) proj info'
			selfInfo
				| proj ^? _Just . projectName `elem` map Just (infos' ^.. each . infoDepends . each) = fromMaybe mempty $
					proj ^? _Just . projectDescription . _Just . projectLibrary . _Just . libraryBuildInfo
				| otherwise = mempty
			-- filter out unavailable packages such as unix under windows
			validDep d = d `elem` pkgs'
			pkgs' = pkgs ^.. each . package . packageName
			hidePackages
				| null (info' ^. infoDepends) = []
				| otherwise = ["-hide-all-packages"]
	_ -> []

-- | Options for GHC of project
projectTargetOpts :: [PackageConfig] -> Project -> Info -> [String]
projectTargetOpts pkgs proj info = concat [hidePackages, targetOpts absInfo] where
	info' = over infoDepends (filter validDep) (selfInfo `mappend` info)
	absInfo = absolutise (view projectPath proj) info'
	selfInfo
		| proj ^. projectName `elem` (info ^.. infoDepends . each) = fromMaybe mempty $
			proj ^? projectDescription . _Just . projectLibrary . _Just . libraryBuildInfo
		| otherwise = mempty
	validDep d = d `elem` pkgs'
	pkgs' = pkgs ^.. each . package . packageName
	hidePackages
		| null (info' ^. infoDepends) = []
		| otherwise = ["-hide-all-packages"]

-- | Set tag to `Inspected`
setTag :: Ord t => t -> Inspected i t a -> Inspected i t a
setTag tag' = over inspectionTags (S.insert tag')

-- | Check whether `Inspected` has tag
hasTag :: Ord t => t -> Inspected i t a -> Bool
hasTag tag' = has (inspectionTags . ix tag')

-- | Drop tag from `Inspected`
removeTag :: Ord t => t -> Inspected i t a -> Inspected i t a
removeTag tag' = over inspectionTags (S.delete tag')

-- | Drop all tags
dropTags :: Inspected i t a -> Inspected i t a
dropTags = set inspectionTags S.empty

-- | Set inspection tag
inspectTag :: (Monad m, Ord t) => t -> InspectM k t m a -> InspectM k t m a
inspectTag tag' act = act <* modify (over _2 (S.insert tag'))

-- | Unser inspection tag
inspectUntag :: (Monad m, Ord t) => t -> InspectM k t m a -> InspectM k t m a
inspectUntag tag' act = act <* modify (over _2 (S.delete tag'))