{-# LANGUAGE OverloadedStrings #-}

module HsDev.Tools.Ghc.Check (
	check,

	Ghc,
	module HsDev.Tools.Types,
	module HsDev.Symbols.Types,
	PackageDb(..), PackageDbStack(..), Project(..),

	recalcNotesTabs,

	module Control.Monad.Except
	) where

import Control.Lens (preview, view, each, (^..), (^.))
import Control.Monad.Except
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.Log.Simple (MonadLog(..), scope, sendLog, Level(Trace))

import GHC hiding (Warning, Module, moduleName)

import Control.Concurrent.FiniteChan
import HsDev.Error
import HsDev.PackageDb
import HsDev.Symbols.Location
import HsDev.Symbols.Types
import HsDev.Tools.Base
import HsDev.Tools.Ghc.Worker
import HsDev.Tools.Ghc.Compat as C
import HsDev.Tools.Types
import HsDev.Util (readFileUtf8, ordNub)
import System.Directory.Paths

-- | Check module source
check :: (MonadLog m, GhcMonad m) => Module -> Maybe Text -> m [Note OutputMessage]
check m msrc = scope "check" $ case view (moduleId . moduleLocation) m of
	FileModule file _ -> do
		ch <- liftIO newChan
		let
			dir = sourceRoot_ (m ^. moduleId)
		ex <- liftIO $ dirExists dir
		sendLog Trace "loading targets"
		withFlags $ (if ex then withCurrentDirectory (dir ^. path) else id) $ do
			modifyFlags $ C.setLogAction $ logToChan ch
			target <- makeTarget (relPathTo dir file) msrc
			loadTargets [target]
		notes <- liftIO $ stopChan ch
		sendLog Trace "targets checked"
		liftIO $ recalcNotesTabs notes
	_ -> scope "check" $ hsdevError $ ModuleNotSource (view (moduleId . moduleLocation) m)

-- Recalc tabs for notes
recalcNotesTabs :: [Note OutputMessage] -> IO [Note OutputMessage]
recalcNotesTabs notes = do
	cts <- mapM (readFileUtf8 . view path) files
	let
		recalc' n = fromMaybe n $ do
			fname <- preview (noteSource . moduleFile) n
			cts' <- lookup fname (zip files cts)
			return $ recalcTabs cts' 8 n
	return $ map recalc' notes
	where
		files = ordNub $ notes ^.. each . noteSource . moduleFile