module HsDev.Tools.HLint (
	hlint,

	module Control.Monad.Except
	) where

import Control.Arrow
import Control.Lens (over, view, _Just)
import Control.Monad.Except
import Data.Char
import Data.List
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Ord
import Data.String (fromString)
import Language.Haskell.HLint3 (argsSettings, parseModuleEx, applyHints, Idea(..), parseErrorMessage, ParseFlags(..), CppFlags(..))
import Language.Haskell.Exts.SrcLoc
import qualified Language.Haskell.HLint3 as HL (Severity(..))

import System.Directory.Paths
import HsDev.Symbols.Location
import HsDev.Tools.Base
import HsDev.Util (readFileUtf8)

hlint :: [String] -> FilePath -> Maybe Text -> ExceptT String IO [Note OutputMessage]
hlint opts file msrc = do
	file' <- liftIO $ canonicalize file
	cts <- maybe (liftIO $ readFileUtf8 file') return msrc
	(flags, classify, hint) <- liftIO $ argsSettings opts
	p <- liftIO $ parseModuleEx (flags { cppFlags = CppSimple }) file' (Just $ T.unpack cts)
	m <- either (throwError . parseErrorMessage) return p
	return $ map (recalcTabs cts 8 . indentIdea cts . fromIdea) $
		filter (not . ignoreIdea) $
		applyHints classify hint [m]

ignoreIdea :: Idea -> Bool
ignoreIdea idea = ideaSeverity idea == HL.Ignore

fromIdea :: Idea -> Note OutputMessage
fromIdea idea = Note {
	_noteSource = FileModule (fromFilePath $ srcSpanFilename src) Nothing,
	_noteRegion = Region (Position (srcSpanStartLine src) (srcSpanStartColumn src)) (Position (srcSpanEndLine src) (srcSpanEndColumn src)),
	_noteLevel = Just $ case ideaSeverity idea of
		HL.Warning -> Warning
		HL.Error -> Error
		_ -> Hint,
	_note = OutputMessage {
		_message = fromString $ ideaHint idea,
		_messageSuggestion = fmap fromString $ ideaTo idea } }
	where
		src = ideaSpan idea

indentIdea :: Text -> Note OutputMessage -> Note OutputMessage
indentIdea cts idea = case analyzeIndent cts of
	Nothing -> idea
	Just i -> over (note . messageSuggestion . _Just) (indent' i) idea
	where
		indent' i' = T.intercalate (fromString "\n") . indentTail . map (uncurry T.append . first ((`T.replicate` i') . (`div` 2) . T.length) . T.span isSpace) . T.split (== '\n')
		indentTail [] = []
		indentTail (h : hs) = h : map (firstIndent `T.append`) hs
		firstIndent = T.takeWhile isSpace firstLine
		firstLine = regionStr (Position firstLineNum 1 `region` Position (succ firstLineNum) 1) cts
		firstLineNum = view (noteRegion . regionFrom . positionLine) idea

-- | Indent in source
data Indent = Spaces Int | Tabs deriving (Eq, Ord)

instance Show Indent where
	show (Spaces n) = replicate n ' '
	show Tabs = "\t"

-- | Analyze source indentation to convert suggestion to same indentation
-- Returns one indent
analyzeIndent :: Text -> Maybe Text
analyzeIndent =
	fmap (fromString . show) . selectIndent . map fst . dropUnusual .
	sortBy (comparing $ negate . snd) .
	map (head &&& length) .
	group . sort .
	mapMaybe (guessIndent . T.takeWhile isSpace) . T.lines
	where
		selectIndent :: [Indent] -> Maybe Indent
		selectIndent [] = Nothing
		selectIndent (Tabs : _) = Just Tabs
		selectIndent indents = Just $ Spaces $ foldr1 gcd $ mapMaybe spaces indents where
			spaces :: Indent -> Maybe Int
			spaces Tabs = Nothing
			spaces (Spaces n) = Just n
		dropUnusual :: [(Indent, Int)] -> [(Indent, Int)]
		dropUnusual [] = []
		dropUnusual is@((_, freq):_) = takeWhile ((> freq `div` 5) . snd) is

-- | Guess indent of one line
guessIndent :: Text -> Maybe Indent
guessIndent s
	| T.all (== ' ') s = Just $ Spaces $ T.length s
	| T.all (== '\t') s = Just Tabs
	| otherwise = Nothing