{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- Copyright (C) 2008 JP Bernardy

-- | This module defines the Region ADT

module Yi.Region
  ( Region
  , emptyRegion
  , regionIsEmpty
  , mkRegion, mkRegion', mkSizeRegion
  , regionStart
  , regionEnd
  , regionSize
  , regionDirection
  , inRegion, nearRegion
  , includedRegion
  , fmapRegion
  , intersectRegion
  , unionRegion
  , regionFirst, regionLast, regionsOverlap
  ) where

import Yi.Buffer.Basic
import Yi.Utils
import Data.Typeable
import Data.Binary
import GHC.Generics (Generic)

-- | The region data type.
-- The region is semi open: it includes the start but not the end bound.
-- This allows simpler region-manipulation algorithms.
-- Invariant : regionStart r <= regionEnd r
data Region = Region
    { Region -> Direction
regionDirection :: !Direction
    , Region -> Point
regionStart, Region -> Point
regionEnd :: !Point
    } deriving (Typeable, (forall x. Region -> Rep Region x)
-> (forall x. Rep Region x -> Region) -> Generic Region
forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Region x -> Region
$cfrom :: forall x. Region -> Rep Region x
Generic)

instance Binary Region

instance Show Region where
    show :: Region -> String
show Region
r = Point -> String
forall a. Show a => a -> String
show (Region -> Point
regionStart Region
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++
             (case Region -> Direction
regionDirection Region
r of
               Direction
Forward -> String
" -> "
               Direction
Backward -> String
" <- "
             ) String -> ShowS
forall a. [a] -> [a] -> [a]
++
             Point -> String
forall a. Show a => a -> String
show (Region -> Point
regionEnd Region
r)

regionFirst :: Region -> Point
regionFirst :: Region -> Point
regionFirst (Region Direction
Forward Point
p Point
_) = Point
p
regionFirst (Region Direction
Backward Point
_ Point
p) = Point
p

regionLast :: Region -> Point
regionLast :: Region -> Point
regionLast (Region Direction
Forward Point
_ Point
p) = Point
p
regionLast (Region Direction
Backward Point
p Point
_) = Point
p


fmapRegion :: (Point -> Point) -> Region -> Region
fmapRegion :: (Point -> Point) -> Region -> Region
fmapRegion Point -> Point
f (Region Direction
d Point
x Point
y) = Direction -> Point -> Point -> Region
Region Direction
d (Point -> Point
f Point
x) (Point -> Point
f Point
y)

regionSize :: Region -> Size
regionSize :: Region -> Size
regionSize Region
r = Region -> Point
regionEnd Region
r Point -> Point -> Size
forall absolute relative.
SemiNum absolute relative =>
absolute -> absolute -> relative
~- Region -> Point
regionStart Region
r

-- | Take the intersection of two regions
intersectRegion :: Region -> Region -> Region
intersectRegion :: Region -> Region -> Region
intersectRegion (Region Direction
_ Point
x1 Point
y1) (Region Direction
_ Point
x2 Point
y2) = Point -> Point -> Region
ordRegion (Point -> Point -> Point
forall a. Ord a => a -> a -> a
max Point
x1 Point
x2) (Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
y1 Point
y2)

-- | Take the union of two regions (including what is between them)
unionRegion :: Region -> Region -> Region
unionRegion :: Region -> Region -> Region
unionRegion (Region Direction
_ Point
x1 Point
y1) (Region Direction
_ Point
x2 Point
y2) = Point -> Point -> Region
mkRegion (Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
x1 Point
x2) (Point -> Point -> Point
forall a. Ord a => a -> a -> a
max Point
y1 Point
y2)


-- | Create a region from ordered bounds. If 2nd argument is greater than
-- 1st, then the region will be empty.
ordRegion :: Point -> Point -> Region
ordRegion :: Point -> Point -> Region
ordRegion Point
x Point
y = if Point
x Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
y then Direction -> Point -> Point -> Region
Region Direction
Forward Point
x Point
y else Region
emptyRegion

-- | Construct a region from its bounds, emacs style:
-- the right bound is excluded
mkRegion :: Point -> Point -> Region
mkRegion :: Point -> Point -> Region
mkRegion Point
x Point
y = if Point
x Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
y then Direction -> Point -> Point -> Region
Region Direction
Forward Point
x Point
y else Direction -> Point -> Point -> Region
Region Direction
Backward Point
y Point
x

mkRegion' :: Direction -> Point -> Point -> Region
mkRegion' :: Direction -> Point -> Point -> Region
mkRegion' Direction
d Point
x Point
y = if Point
x Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
y then Direction -> Point -> Point -> Region
Region Direction
d Point
x Point
y else Direction -> Point -> Point -> Region
Region Direction
d Point
y Point
x

mkSizeRegion :: Point -> Size -> Region
mkSizeRegion :: Point -> Size -> Region
mkSizeRegion Point
x Size
s = Point -> Point -> Region
mkRegion Point
x (Point
x Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Size
s)

-- | The empty region
emptyRegion :: Region
emptyRegion :: Region
emptyRegion = Direction -> Point -> Point -> Region
Region Direction
Forward Point
0 Point
0

-- | True if the given point is inside the given region.
inRegion :: Point -> Region -> Bool
Point
p inRegion :: Point -> Region -> Bool
`inRegion` (Region Direction
_ Point
start Point
stop) = Point
start Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
p Bool -> Bool -> Bool
&& Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
stop

-- | True if the given point is inside the given region or at the end of it.
nearRegion :: Point -> Region -> Bool
Point
p nearRegion :: Point -> Region -> Bool
`nearRegion` (Region Direction
_ Point
start Point
stop) = Point
start Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
p Bool -> Bool -> Bool
&& Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
stop

-- | Returns if a region (1st arg) is  included in another (2nd arg)
includedRegion :: Region -> Region -> Bool
Region
r0 includedRegion :: Region -> Region -> Bool
`includedRegion` Region
r = Region -> Point
regionStart Region
r Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Region -> Point
regionStart Region
r0 Bool -> Bool -> Bool
&& Region -> Point
regionEnd Region
r0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Region -> Point
regionEnd Region
r

regionIsEmpty :: Region -> Bool
regionIsEmpty :: Region -> Bool
regionIsEmpty (Region Direction
_ Point
start Point
stop) = Point
start Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
stop

regionsOverlap :: Bool -> Region -> Region -> Bool
regionsOverlap :: Bool -> Region -> Region -> Bool
regionsOverlap Bool
border (Region Direction
_ Point
x1 Point
y1) (Region Direction
_ Point
x2 Point
y2) =
    Point -> Point -> Point -> Bool
forall a. Ord a => a -> a -> a -> Bool
cmp Point
x2 Point
y1 Point
y2 Bool -> Bool -> Bool
|| Point -> Point -> Point -> Bool
forall a. Ord a => a -> a -> a -> Bool
cmp Point
x2 Point
x1 Point
y2 Bool -> Bool -> Bool
||
    Point -> Point -> Point -> Bool
forall a. Ord a => a -> a -> a -> Bool
cmp Point
x1 Point
y2 Point
y1 Bool -> Bool -> Bool
|| Point -> Point -> Point -> Bool
forall a. Ord a => a -> a -> a -> Bool
cmp Point
x1 Point
x2 Point
y1
  where
    cmp :: a -> a -> a -> Bool
cmp a
a a
b a
c = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b Bool -> Bool -> Bool
&& if Bool
border then a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
c  else a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
c