{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Tools.AutoFix (
	corrections,
	CorrectorMatch,
	correctors,
	match,
	findCorrector,

	module Data.Text.Region,
	module HsDev.Tools.Refact,
	module HsDev.Tools.Types
	) where

import Control.Applicative
import Control.Lens hiding ((.=), at)
import Data.Maybe (listToMaybe, mapMaybe)
import Data.String (fromString)
import Data.Text (Text)
import Data.Text.Lens (unpacked)
import Data.Text.Region hiding (Region(..), update)
import qualified Data.Text.Region as R

import HsDev.Tools.Refact
import HsDev.Tools.Base
import HsDev.Tools.Types

instance Regioned a => Regioned (Note a) where
	regions :: (Region -> f Region) -> Note a -> f (Note a)
regions = (a -> f a) -> Note a -> f (Note a)
forall a1 a2. Lens (Note a1) (Note a2) a1 a2
note ((a -> f a) -> Note a -> f (Note a))
-> ((Region -> f Region) -> a -> f a)
-> (Region -> f Region)
-> Note a
-> f (Note a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Region -> f Region) -> a -> f a
forall a. Regioned a => Traversal' a Region
regions

corrections :: [Note OutputMessage] -> [Note Refact]
corrections :: [Note OutputMessage] -> [Note Refact]
corrections = (Note OutputMessage -> Maybe (Note Refact))
-> [Note OutputMessage] -> [Note Refact]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Note OutputMessage -> Maybe (Note Refact)
toRefact where
	toRefact :: Note OutputMessage -> Maybe (Note Refact)
	toRefact :: Note OutputMessage -> Maybe (Note Refact)
toRefact Note OutputMessage
n = Maybe (Note Refact)
useSuggestion Maybe (Note Refact) -> Maybe (Note Refact) -> Maybe (Note Refact)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Note OutputMessage -> Maybe (Note Refact)
findCorrector Note OutputMessage
n where
		-- Use existing suggestion
		useSuggestion :: Maybe (Note Refact)
		useSuggestion :: Maybe (Note Refact)
useSuggestion = do
			Text
sugg <- Getting (Maybe Text) (Note OutputMessage) (Maybe Text)
-> Note OutputMessage -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((OutputMessage -> Const (Maybe Text) OutputMessage)
-> Note OutputMessage -> Const (Maybe Text) (Note OutputMessage)
forall a1 a2. Lens (Note a1) (Note a2) a1 a2
note ((OutputMessage -> Const (Maybe Text) OutputMessage)
 -> Note OutputMessage -> Const (Maybe Text) (Note OutputMessage))
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> OutputMessage -> Const (Maybe Text) OutputMessage)
-> Getting (Maybe Text) (Note OutputMessage) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> OutputMessage -> Const (Maybe Text) OutputMessage
Lens' OutputMessage (Maybe Text)
messageSuggestion) Note OutputMessage
n
			Note Refact -> Maybe (Note Refact)
forall (m :: * -> *) a. Monad m => a -> m a
return (Note Refact -> Maybe (Note Refact))
-> Note Refact -> Maybe (Note Refact)
forall a b. (a -> b) -> a -> b
$ ASetter (Note OutputMessage) (Note Refact) OutputMessage Refact
-> Refact -> Note OutputMessage -> Note Refact
forall s t a b. ASetter s t a b -> b -> s -> t
set
				ASetter (Note OutputMessage) (Note Refact) OutputMessage Refact
forall a1 a2. Lens (Note a1) (Note a2) a1 a2
note
				(Text -> Replace Text -> Refact
Refact
					(Getting Text (Note OutputMessage) Text
-> Note OutputMessage -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((OutputMessage -> Const Text OutputMessage)
-> Note OutputMessage -> Const Text (Note OutputMessage)
forall a1 a2. Lens (Note a1) (Note a2) a1 a2
note ((OutputMessage -> Const Text OutputMessage)
 -> Note OutputMessage -> Const Text (Note OutputMessage))
-> ((Text -> Const Text Text)
    -> OutputMessage -> Const Text OutputMessage)
-> Getting Text (Note OutputMessage) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> OutputMessage -> Const Text OutputMessage
Lens' OutputMessage Text
message) Note OutputMessage
n)
					(Region -> Text -> Replace Text
forall (e :: * -> *) s. EditAction e s => Region -> s -> e s
replace (Region -> Region
fromRegion (Region -> Region) -> Region -> Region
forall a b. (a -> b) -> a -> b
$ Getting Region (Note OutputMessage) Region
-> Note OutputMessage -> Region
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Region (Note OutputMessage) Region
forall a1. Lens' (Note a1) Region
noteRegion Note OutputMessage
n) Text
sugg))
				Note OutputMessage
n

type CorrectorMatch = Note OutputMessage -> Maybe (Note Refact)

correctors :: [CorrectorMatch]
correctors :: [Note OutputMessage -> Maybe (Note Refact)]
correctors = [
	String
-> ((Int -> Maybe Text) -> Region -> Refact)
-> Note OutputMessage
-> Maybe (Note Refact)
match String
"^The (?:qualified )?import of .([\\w\\.]+). is redundant" (((Int -> Maybe Text) -> Region -> Refact)
 -> Note OutputMessage -> Maybe (Note Refact))
-> ((Int -> Maybe Text) -> Region -> Refact)
-> Note OutputMessage
-> Maybe (Note Refact)
forall a b. (a -> b) -> a -> b
$ \Int -> Maybe Text
_ Region
rgn -> Text -> Replace Text -> Refact
Refact -- There are different quotes in Windows/Linux
		Text
"Redundant import"
		(Region -> Replace Text
forall (e :: * -> *) s. EditAction e s => Region -> e s
cut
			(Region -> Region
expandLines Region
rgn)),
	String
-> ((Int -> Maybe Text) -> Region -> Refact)
-> Note OutputMessage
-> Maybe (Note Refact)
match String
"^(.*?)\nFound:\n  (.*?)\nWhy not:\n  (.*?)$" (((Int -> Maybe Text) -> Region -> Refact)
 -> Note OutputMessage -> Maybe (Note Refact))
-> ((Int -> Maybe Text) -> Region -> Refact)
-> Note OutputMessage
-> Maybe (Note Refact)
forall a b. (a -> b) -> a -> b
$ \Int -> Maybe Text
g Region
rgn -> Text -> Replace Text -> Refact
Refact
		(Int -> Maybe Text
g (Int -> Maybe Text) -> Int -> Text
forall a. (Int -> Maybe a) -> Int -> a
`at` Int
1)
		(Region -> Text -> Replace Text
forall (e :: * -> *) s. EditAction e s => Region -> s -> e s
replace
			((Region
rgn Region -> Getting Point Region Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point Region Point
Lens' Region Point
regionFrom) Point -> Point -> Region
`regionSize` Int -> Int -> Point
pt Int
0 (Text -> Int
forall a. Editable a => a -> Int
contentsLength (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Text
g (Int -> Maybe Text) -> Int -> Text
forall a. (Int -> Maybe a) -> Int -> a
`at` Int
2))
			(Int -> Maybe Text
g (Int -> Maybe Text) -> Int -> Text
forall a. (Int -> Maybe a) -> Int -> a
`at` Int
3))]

match :: String -> ((Int -> Maybe Text) -> R.Region -> Refact) -> CorrectorMatch
match :: String
-> ((Int -> Maybe Text) -> Region -> Refact)
-> Note OutputMessage
-> Maybe (Note Refact)
match String
pat (Int -> Maybe Text) -> Region -> Refact
f Note OutputMessage
n = do
	Int -> Maybe String
g <- String -> String -> Maybe (Int -> Maybe String)
matchRx String
pat (Getting String (Note OutputMessage) String
-> Note OutputMessage -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((OutputMessage -> Const String OutputMessage)
-> Note OutputMessage -> Const String (Note OutputMessage)
forall a1 a2. Lens (Note a1) (Note a2) a1 a2
note ((OutputMessage -> Const String OutputMessage)
 -> Note OutputMessage -> Const String (Note OutputMessage))
-> ((String -> Const String String)
    -> OutputMessage -> Const String OutputMessage)
-> Getting String (Note OutputMessage) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const String Text)
-> OutputMessage -> Const String OutputMessage
Lens' OutputMessage Text
message ((Text -> Const String Text)
 -> OutputMessage -> Const String OutputMessage)
-> ((String -> Const String String) -> Text -> Const String Text)
-> (String -> Const String String)
-> OutputMessage
-> Const String OutputMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Text -> Const String Text
forall t. IsText t => Iso' t String
unpacked) Note OutputMessage
n)
	Note Refact -> Maybe (Note Refact)
forall (m :: * -> *) a. Monad m => a -> m a
return (Note Refact -> Maybe (Note Refact))
-> Note Refact -> Maybe (Note Refact)
forall a b. (a -> b) -> a -> b
$ ASetter (Note OutputMessage) (Note Refact) OutputMessage Refact
-> Refact -> Note OutputMessage -> Note Refact
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Note OutputMessage) (Note Refact) OutputMessage Refact
forall a1 a2. Lens (Note a1) (Note a2) a1 a2
note ((Int -> Maybe Text) -> Region -> Refact
f ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. IsString a => String -> a
fromString (Maybe String -> Maybe Text)
-> (Int -> Maybe String) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String
g) (Region -> Region
fromRegion (Region -> Region) -> Region -> Region
forall a b. (a -> b) -> a -> b
$ Getting Region (Note OutputMessage) Region
-> Note OutputMessage -> Region
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Region (Note OutputMessage) Region
forall a1. Lens' (Note a1) Region
noteRegion Note OutputMessage
n)) Note OutputMessage
n

findCorrector :: Note OutputMessage -> Maybe (Note Refact)
findCorrector :: Note OutputMessage -> Maybe (Note Refact)
findCorrector Note OutputMessage
n = [Note Refact] -> Maybe (Note Refact)
forall a. [a] -> Maybe a
listToMaybe ([Note Refact] -> Maybe (Note Refact))
-> [Note Refact] -> Maybe (Note Refact)
forall a b. (a -> b) -> a -> b
$ ((Note OutputMessage -> Maybe (Note Refact))
 -> Maybe (Note Refact))
-> [Note OutputMessage -> Maybe (Note Refact)] -> [Note Refact]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Note OutputMessage -> Maybe (Note Refact))
-> Note OutputMessage -> Maybe (Note Refact)
forall a b. (a -> b) -> a -> b
$ Note OutputMessage
n) [Note OutputMessage -> Maybe (Note Refact)]
correctors