module Control.OperationalTransformation.Selection
( Range (..)
, Selection (..)
, createCursor
, size
, somethingSelected
) where
import Control.OperationalTransformation
import Control.OperationalTransformation.Text
import Data.Aeson
import Control.Applicative
import Data.Monoid
import Data.List (sort)
import qualified Data.Text as T
#if MIN_VERSION_ghc(7,8,0)
import GHC.Exts (IsList (..))
#endif
data Range = Range { rangeAnchor :: !Int, rangeHead :: !Int }
deriving (Show, Read, Eq, Ord)
instance ToJSON Range where
toJSON (Range a h) = object [ "anchor" .= a, "head" .= h ]
instance FromJSON Range where
parseJSON (Object o) = Range <$> o .: "anchor" <*> o .: "head"
parseJSON _ = fail "expected an object"
instance OTCursor Range TextOperation where
updateCursor (TextOperation actions) (Range a h) = Range a' h'
where
a' = updateComponent a
h' = if a == h then a' else updateComponent h
updateComponent c = loop c c actions
loop :: Int -> Int -> [Action] -> Int
loop oldIndex newIndex as
| oldIndex < 0 = newIndex
| otherwise =
case as of
(op:ops) -> case op of
Retain r -> loop (oldIndexr) newIndex ops
Insert i -> loop oldIndex (newIndex + T.length i) ops
Delete d -> loop (oldIndexd) (newIndex min oldIndex d) ops
_ -> newIndex
newtype Selection = Selection { ranges :: [Range] }
deriving (Monoid, Show, Read)
instance OTCursor Selection TextOperation where
updateCursor op = Selection . updateCursor op . ranges
instance Eq Selection where
Selection rs1 == Selection rs2 = sort rs1 == sort rs2
instance Ord Selection where
Selection rs1 `compare` Selection rs2 = sort rs1 `compare` sort rs2
instance ToJSON Selection where
toJSON (Selection rs) = object [ "ranges" .= rs ]
instance FromJSON Selection where
parseJSON (Object o) = Selection <$> o .: "ranges"
parseJSON _ = fail "expected an object"
#if MIN_VERSION_ghc(7,8,0)
instance IsList Selection where
type Item Selection = Range
fromList = Selection
toList = ranges
#endif
createCursor :: Int -> Selection
createCursor i = Selection [Range i i]
somethingSelected :: Selection -> Bool
somethingSelected = any (\r -> rangeAnchor r /= rangeHead r) . ranges
size :: Selection -> Int
size = sum . map (\r -> abs (rangeAnchor r rangeHead r)) . ranges