{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}

module HsDev.Tools.Refact (
	Refact(..), refactMessage, refactAction,
	refact, update,

	replace, cut, paste,

	fromRegion, fromPosition
	) where

import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Text (Text)
import Data.Text.Region hiding (Region(..), update)
import qualified Data.Text.Region as R

import HsDev.Symbols.Location
import HsDev.Util

data Refact = Refact {
	Refact -> Text
_refactMessage :: Text,
	Refact -> Replace Text
_refactAction :: Replace Text }
		deriving (Refact -> Refact -> Bool
(Refact -> Refact -> Bool)
-> (Refact -> Refact -> Bool) -> Eq Refact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Refact -> Refact -> Bool
$c/= :: Refact -> Refact -> Bool
== :: Refact -> Refact -> Bool
$c== :: Refact -> Refact -> Bool
Eq, Int -> Refact -> ShowS
[Refact] -> ShowS
Refact -> String
(Int -> Refact -> ShowS)
-> (Refact -> String) -> ([Refact] -> ShowS) -> Show Refact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Refact] -> ShowS
$cshowList :: [Refact] -> ShowS
show :: Refact -> String
$cshow :: Refact -> String
showsPrec :: Int -> Refact -> ShowS
$cshowsPrec :: Int -> Refact -> ShowS
Show)

instance Ord Refact where
	compare :: Refact -> Refact -> Ordering
compare (Refact Text
lmsg Replace Text
_) (Refact Text
rmsg Replace Text
_) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lmsg Text
rmsg

instance ToJSON Refact where
	toJSON :: Refact -> Value
toJSON (Refact Text
msg Replace Text
cor) = [Pair] -> Value
object [
		Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
msg,
		Text
"action" Text -> Replace Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Replace Text
cor]

instance FromJSON Refact where
	parseJSON :: Value -> Parser Refact
parseJSON = String -> (Object -> Parser Refact) -> Value -> Parser Refact
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"correction" ((Object -> Parser Refact) -> Value -> Parser Refact)
-> (Object -> Parser Refact) -> Value -> Parser Refact
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> Replace Text -> Refact
Refact (Text -> Replace Text -> Refact)
-> Parser Text -> Parser (Replace Text -> Refact)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"message" Parser (Replace Text -> Refact)
-> Parser (Replace Text) -> Parser Refact
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Replace Text)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"action"

makeLenses ''Refact

instance Regioned Refact where
	regions :: (Region -> f Region) -> Refact -> f Refact
regions = (Replace Text -> f (Replace Text)) -> Refact -> f Refact
Lens' Refact (Replace Text)
refactAction ((Replace Text -> f (Replace Text)) -> Refact -> f Refact)
-> ((Region -> f Region) -> Replace Text -> f (Replace Text))
-> (Region -> f Region)
-> Refact
-> f Refact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Region -> f Region) -> Replace Text -> f (Replace Text)
forall a. Regioned a => Traversal' a Region
regions

refact :: [Refact] -> Text -> Text
refact :: [Refact] -> Text -> Text
refact [Refact]
rs = Edit Text -> Text -> Text
forall s. Editable s => Edit s -> s -> s
apply Edit Text
act where
	act :: Edit Text
act = [Replace Text] -> Edit Text
forall s. [Replace s] -> Edit s
Edit ([Refact]
rs [Refact]
-> Getting (Endo [Replace Text]) [Refact] (Replace Text)
-> [Replace Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Refact -> Const (Endo [Replace Text]) Refact)
-> [Refact] -> Const (Endo [Replace Text]) [Refact]
forall s t a b. Each s t a b => Traversal s t a b
each ((Refact -> Const (Endo [Replace Text]) Refact)
 -> [Refact] -> Const (Endo [Replace Text]) [Refact])
-> ((Replace Text -> Const (Endo [Replace Text]) (Replace Text))
    -> Refact -> Const (Endo [Replace Text]) Refact)
-> Getting (Endo [Replace Text]) [Refact] (Replace Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Replace Text -> Const (Endo [Replace Text]) (Replace Text))
-> Refact -> Const (Endo [Replace Text]) Refact
Lens' Refact (Replace Text)
refactAction)

update :: Regioned a => [Refact] -> [a] -> [a]
update :: [Refact] -> [a] -> [a]
update [Refact]
rs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Edit Text -> a -> a
forall s r. (Editable s, Regioned r) => Edit s -> r -> r
R.update Edit Text
act) where
	act :: Edit Text
act = [Replace Text] -> Edit Text
forall s. [Replace s] -> Edit s
Edit ([Refact]
rs [Refact]
-> Getting (Endo [Replace Text]) [Refact] (Replace Text)
-> [Replace Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Refact -> Const (Endo [Replace Text]) Refact)
-> [Refact] -> Const (Endo [Replace Text]) [Refact]
forall s t a b. Each s t a b => Traversal s t a b
each ((Refact -> Const (Endo [Replace Text]) Refact)
 -> [Refact] -> Const (Endo [Replace Text]) [Refact])
-> ((Replace Text -> Const (Endo [Replace Text]) (Replace Text))
    -> Refact -> Const (Endo [Replace Text]) Refact)
-> Getting (Endo [Replace Text]) [Refact] (Replace Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Replace Text -> Const (Endo [Replace Text]) (Replace Text))
-> Refact -> Const (Endo [Replace Text]) Refact
Lens' Refact (Replace Text)
refactAction)

fromRegion :: Region -> R.Region
fromRegion :: Region -> Region
fromRegion (Region Position
f Position
t) = Position -> Point
fromPosition Position
f Point -> Point -> Region
`till` Position -> Point
fromPosition Position
t

fromPosition :: Position -> Point
fromPosition :: Position -> Point
fromPosition (Position Int
l Int
c) = Int -> Int -> Point
pt (Int -> Int
forall a. Enum a => a -> a
pred Int
l) (Int -> Int
forall a. Enum a => a -> a
pred Int
c)