{-# LANGUAGE RankNTypes, TupleSections, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}



module Data.Text.Region (

	pt, start, lineStart, regionLength, till, linesSize, regionLines, emptyRegion, line,

	regionSize, expandLines, atRegion, overlaps, applyMap, cutMap, insertMap,

	cutRegion, insertRegion,

	EditAction(..), replace, cut, paste, overwrite, apply, update, undo,



	module Data.Text.Region.Types

	) where



import Prelude hiding (id, (.))

import Prelude.Unicode



import Control.Category

import Control.Lens



import Data.Text.Region.Types



-- | Make 'Point' from line and column

pt ∷ Int → Int → Point

pt = Point



-- | 'Point' at the beginning

start ∷ Point

start = pt 0 0



-- | 'Point' at the beginning of line

lineStart ∷ Int → Point

lineStart l = pt l 0



-- | Regions length

regionLength ∷ Lens' Region Size

regionLength = lens fromr tor where

	fromr (Region f t) = t .-. f

	tor (Region f _) sz = Region f (f .+. sz)



-- | Region from one 'Point' to another

till ∷ Point → Point → Region

l `till` r = Region (min l r) (max l r)



-- | Distance of @n@ lines

linesSize ∷ Int → Size

linesSize = pt 0



-- 'Region' height in lines, any 'Region' at least of line height 1

regionLines ∷ Lens' Region Int

regionLines = lens fromr tor where

	fromr (Region f t) = succ $ (t ^. pointLine) - (f ^. pointLine)

	tor (Region f t) l = Region f (set pointLine (f ^. pointLine + l) t)



-- | Is 'Region' empty

emptyRegion ∷ Region → Bool

emptyRegion r = r ^. regionFrom ≡ r ^. regionTo



-- | n'th line region, starts at the beginning of line and ends on the next line

line ∷ Int → Region

line l = lineStart l `till` lineStart (succ l)



-- | Make 'Region' by start position and 'Size'

regionSize ∷ Point → Size → Region

regionSize pt' sz = pt' `till` (pt' .+. sz)



-- | Expand 'Region' to contain full lines

expandLines ∷ Region → Region

expandLines (Region f t) = lineStart (f ^. pointLine) `till` lineStart (succ $ t ^. pointLine)



-- | Get contents at 'Region'

atRegion ∷ Editable s ⇒ Region → Lens' (Contents s) (Contents s)

atRegion r = lens fromc toc where

	fromc cts = cts ^. splitted (r ^. regionTo) . _1 . splitted (r ^. regionFrom) . _2

	toc cts cts' = (cts ^. splitted (r ^. regionFrom) . _1) `concatCts` cts' `concatCts` (cts ^. splitted (r ^. regionTo) . _2)



-- | Does regions overlaps

overlaps ∷ Region → Region → Bool

overlaps l r

	| r ^. regionFrom ≥ l ^. regionTo = False

	| r ^. regionTo ≤ l ^. regionFrom = False

	| otherwise = True



applyMap ∷ Map → Region → Region

applyMap = view ∘ mapIso



-- | Cut 'Region' mapping

cutMap ∷ Region → Map

cutMap rgn = Map $ iso (cutRegion rgn) (insertRegion rgn)



-- | Opposite to 'cutMap'

insertMap ∷ Region → Map

insertMap = invert ∘ cutMap



-- | Update second 'Region' position as if it was data cutted at first 'Region'

cutRegion ∷ Region → Region → Region

cutRegion (Region is ie) (Region s e) = Region

	(if is < s then (s .-. ie) .+. is else s)

	(if is < e then (e .-. ie) .+. is else e)



-- | Update second region position as if it was data inserted at first region (region sets insertion point and data size)

-- Region tries not to extend if data inserted at region bound except when region is empty

-- This allows define replace as cut and insert in special case when we replace region itself

insertRegion ∷ Region → Region → Region

insertRegion (Region is ie) (Region s e)

	| (s ≡ e) ∧ (is ≡ s) = Region is ie

	| otherwise = Region

		(if is ≤ s then (s .-. is) .+. ie else s)

		(if is < e then (e .-. is) .+. ie else e)



class Editable s ⇒ EditAction e s where

	-- | Make replace action over 'Region' and 'Contents'

	replaceAction ∷ Region → Contents s → e s

	-- | Make 'Map' from action

	actionMap ∷ e s → Map

	-- | Perform action, modifying 'Contents'

	perform ∷ e s → Contents s → Contents s

	-- | Get action undo

	inversed ∷ e s → Contents s → e s



-- | Replace region with data

replace ∷ EditAction e s ⇒ Region → s → e s

replace r = replaceAction r ∘ view contents



-- | Cuts region

cut ∷ EditAction e s ⇒ Region → e s

cut r = replaceAction r emptyContents



-- | Pastes 'Contents' at some 'Point'

paste ∷ EditAction e s ⇒ Point → s → e s

paste p = replaceAction (p `till` p) ∘ view contents



-- | Overwrites 'Contents' at some 'Point'

overwrite ∷ EditAction e s ⇒ Point → s → e s

overwrite p c = replaceAction (p `regionSize` measure cts) cts where

	cts = view contents c



-- | 'perform' for 'Edit'

apply ∷ Editable s ⇒ Edit s → s → s

apply = over contents ∘ perform



-- | Get undo

undo ∷ Editable s ⇒ Edit s → s → Edit s

undo e = inversed e ∘ view contents



-- | Update regions

update ∷ (Editable s, Regioned r) ⇒ Edit s → r → r

update e = over regions (applyMap ∘ actionMap $ e)



instance Editable s ⇒ EditAction Replace s where

	replaceAction = Replace

	actionMap (Replace r w) = insertMap (r & regionLength .~ measure w) `mappend` cutMap r

	perform (Replace r w) cts = cts & atRegion r .~ w

	inversed (Replace r w) cts = Replace (r & regionLength .~ measure w) (cts ^. atRegion r)



instance Editable s ⇒ EditAction Edit s where

	replaceAction rgn txt = Edit [replaceAction rgn txt]

	actionMap = foldr go mempty ∘ view replaces where

		go r m = actionMap (over replaceRegion (applyMap m) r) `mappend` m

	perform = snd ∘ foldr go (mempty, id) ∘ view replaces where

		go r (m, fn) = (actionMap r' `mappend` m, perform r' ∘ fn) where

			r' = over replaceRegion (applyMap m) r

	inversed e@(Edit rs) cts = Edit [Replace (applyMap m r) (cts ^. atRegion r) | Replace r _ ← rs] where

		m = actionMap e