diff --git a/rasa-ext-cursors.cabal b/rasa-ext-cursors.cabal --- a/rasa-ext-cursors.cabal +++ b/rasa-ext-cursors.cabal @@ -1,5 +1,5 @@ name: rasa-ext-cursors -version: 0.1.2 +version: 0.1.3 cabal-version: >=1.10 build-type: Simple license: MIT @@ -20,6 +20,8 @@ library exposed-modules: Rasa.Ext.Cursors + Rasa.Ext.Cursors.Internal.Actions + Rasa.Ext.Cursors.Internal.Base build-depends: base >=4.8 && <5, rasa >=0.1.6 && <0.2, @@ -32,8 +34,5 @@ data-default >=0.7.1.1 && <0.8 default-language: Haskell2010 hs-source-dirs: src - other-modules: - Rasa.Ext.Cursors.Actions - Rasa.Ext.Cursors.Base ghc-options: -Wall diff --git a/src/Rasa/Ext/Cursors.hs b/src/Rasa/Ext/Cursors.hs --- a/src/Rasa/Ext/Cursors.hs +++ b/src/Rasa/Ext/Cursors.hs @@ -22,8 +22,8 @@ ) where import Rasa.Ext -import Rasa.Ext.Cursors.Base -import Rasa.Ext.Cursors.Actions +import Rasa.Ext.Cursors.Internal.Base +import Rasa.Ext.Cursors.Internal.Actions import Control.Monad diff --git a/src/Rasa/Ext/Cursors/Actions.hs b/src/Rasa/Ext/Cursors/Actions.hs deleted file mode 100644 --- a/src/Rasa/Ext/Cursors/Actions.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Rasa.Ext.Cursors.Actions - ( delete - , insertText - , findNext - , findPrev - , findNextFrom - , findPrevFrom - , moveRangesByN - , moveRangesByC - ) where - -import qualified Yi.Rope as Y -import qualified Data.Text as T - -import Control.Lens -import Control.Lens.Text -import Rasa.Ext -import Rasa.Ext.Cursors.Base - --- | Moves all Ranges that are on the same END row as the given range by the coord's row and column --- This is used to adjust cursors when things have been inserted/deleted before them in the row. -moveSameLineRangesBy :: Range -> Coord -> BufAction () -moveSameLineRangesBy (Range _ (Coord endRow endCol)) amt = do - let moveInLine r@(Range (Coord startRow startCol) _) = return $ - if endRow == startRow && startCol > endCol - then moveRange amt r - else r - ranges <~ rangeDo moveInLine - --- | Delete the text of all ranges in a buffer -delete :: BufAction () -delete = rangeDo_ $ \r -> do - deleteRange r - moveSameLineRangesBy r (negate $ sizeOfR r) - --- | Insert text at the beginning of all ranges in the buffer. -insertText :: Y.YiString -> BufAction () -insertText txt = rangeDo_ $ \r@(Range s _) -> do - insertAt s txt - moveSameLineRangesBy r (Coord 0 (Y.length txt)) - --- | Move all ranges to the location of the next occurence of the given text. -findNext :: Y.YiString -> BufAction () -findNext pat = do - res <- rangeDo $ \(Range _ e) -> do - off <- findNextFrom pat e - let end = moveCursorByN 1 off - return $ Range off end - ranges .= res - --- | Get the 'Coord' of the next occurence of the given text after the given 'Coord' -findNextFrom :: Y.YiString -> Coord -> BufAction Coord -findNextFrom pat c = do - distance <- use (text . afterC c . asText . tillNext (Y.toText pat) . from asText . to sizeOf) - return (distance + c) - --- | Move all ranges to the location of the previous occurence of the given text. -findPrev :: Y.YiString -> BufAction () -findPrev pat = do - res <- rangeDo $ \(Range s _) -> do - off <- findPrevFrom pat s - let end = moveCursorByN 1 off - return $ Range off end - ranges .= res - --- | Get the 'Coord' of the previous occurence of the given text before the given 'Coord' -findPrevFrom :: Y.YiString -> Coord -> BufAction Coord -findPrevFrom pat c = do - txt <- use text - let Offset o = c^.from (asCoord txt) - distance <- use (text . asText . before o . tillPrev (Y.toText pat) . to T.length .to negate) - return ((Offset $ distance + o)^.asCoord txt) - --- | Move all ranges by the given number of columns -moveRangesByN :: Int -> BufAction () -moveRangesByN n = overRanges $ return . moveRangeByN n - --- | Move all ranges by the given number of rows and columns -moveRangesByC :: Coord -> BufAction () -moveRangesByC c = overRanges $ return . moveRange c diff --git a/src/Rasa/Ext/Cursors/Base.hs b/src/Rasa/Ext/Cursors/Base.hs deleted file mode 100644 --- a/src/Rasa/Ext/Cursors/Base.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE TemplateHaskell, OverloadedStrings, Rank2Types #-} - -module Rasa.Ext.Cursors.Base - ( rangeDo - , rangeDo_ - , ranges - , displayRange - , eachRange - , overRanges - , addRange - ) where - - -import Rasa.Ext -import Rasa.Ext.Style - -import Control.Monad.State -import Control.Lens -import Data.Typeable -import Data.List -import Data.Default -import qualified Yi.Rope as Y - --- | Stores the cursor ranges in each buffer. -data Cursors = Cursors - { _cursors :: [Range] - } deriving (Typeable, Show) - -makeLenses ''Cursors - -instance Default Cursors where - def = Cursors { - _cursors=[Range (Coord 0 0) (Coord 0 1)] -} - --- | Adjusts input ranges to contain at least one character. -ensureSize :: Range -> Range -ensureSize r@(Range s e) - | s == e = Range s (moveCursorByN 1 e) - | otherwise = r - --- | Sorts Ranges, removes duplicates, ensures they contain at least one character --- and restricts them to fit within the given text. -cleanRanges :: Y.YiString -> [Range] -> [Range] -cleanRanges txt = fmap (ensureSize . clampRange txt) . reverse . nub . sort - --- | A lens over all the stored cursor ranges for a buffer -ranges :: HasBuffer s => Lens' s [Range] -ranges = lens getter setter - where getter buf = buf^.bufExt.cursors - setter buf new = let txt = buf^.text - in buf & bufExt.cursors .~ cleanRanges txt new - --- | A Traversal over each Range for the given buffer. -eachRange :: HasBuffer s => Traversal' s Range -eachRange = ranges.traverse - --- | Sequences actions over each range as a 'BufAction' -rangeDo :: (Range -> BufAction a) -> BufAction [a] -rangeDo f = use ranges >>= mapM f - --- | 'rangeDo' with void return. -rangeDo_ :: (Range -> BufAction a) -> BufAction () -rangeDo_ = void . rangeDo - --- | Sequences actions over each range and replaces each range with its result. -overRanges :: (Range -> BufAction Range) -> BufAction () -overRanges f = ranges <~ rangeDo f - --- | Adds a new range to the list of ranges. -addRange :: Range -> BufAction () -addRange r = ranges <>= [r] - --- | Sets style attributes to show a given range. -displayRange :: BufAction () -displayRange = rangeDo_ setStyle - where - setStyle :: Range -> BufAction () - setStyle r = addStyle r (flair ReverseVideo) diff --git a/src/Rasa/Ext/Cursors/Internal/Actions.hs b/src/Rasa/Ext/Cursors/Internal/Actions.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Ext/Cursors/Internal/Actions.hs @@ -0,0 +1,80 @@ +module Rasa.Ext.Cursors.Internal.Actions + ( delete + , insertText + , findNext + , findPrev + , findNextFrom + , findPrevFrom + , moveRangesByN + , moveRangesByC + ) where + +import qualified Yi.Rope as Y +import qualified Data.Text as T + +import Control.Lens +import Control.Lens.Text +import Rasa.Ext +import Rasa.Ext.Cursors.Internal.Base + +-- | Moves all Ranges that are on the same END row as the given range by the coord's row and column +-- This is used to adjust cursors when things have been inserted/deleted before them in the row. +moveSameLineRangesBy :: Range -> Coord -> BufAction () +moveSameLineRangesBy (Range _ (Coord endRow endCol)) amt = do + let moveInLine r@(Range (Coord startRow startCol) _) = return $ + if endRow == startRow && startCol > endCol + then moveRange amt r + else r + ranges <~ rangeDo moveInLine + +-- | Delete the text of all ranges in a buffer +delete :: BufAction () +delete = rangeDo_ $ \r -> do + deleteRange r + moveSameLineRangesBy r (negate $ sizeOfR r) + +-- | Insert text at the beginning of all ranges in the buffer. +insertText :: Y.YiString -> BufAction () +insertText txt = rangeDo_ $ \r@(Range s _) -> do + insertAt s txt + moveSameLineRangesBy r (Coord 0 (Y.length txt)) + +-- | Move all ranges to the location of the next occurence of the given text. +findNext :: Y.YiString -> BufAction () +findNext pat = do + res <- rangeDo $ \(Range _ e) -> do + off <- findNextFrom pat e + let end = moveCursorByN 1 off + return $ Range off end + ranges .= res + +-- | Get the 'Coord' of the next occurence of the given text after the given 'Coord' +findNextFrom :: Y.YiString -> Coord -> BufAction Coord +findNextFrom pat c = do + distance <- use (text . afterC c . asText . tillNext (Y.toText pat) . from asText . to sizeOf) + return (distance + c) + +-- | Move all ranges to the location of the previous occurence of the given text. +findPrev :: Y.YiString -> BufAction () +findPrev pat = do + res <- rangeDo $ \(Range s _) -> do + off <- findPrevFrom pat s + let end = moveCursorByN 1 off + return $ Range off end + ranges .= res + +-- | Get the 'Coord' of the previous occurence of the given text before the given 'Coord' +findPrevFrom :: Y.YiString -> Coord -> BufAction Coord +findPrevFrom pat c = do + txt <- use text + let Offset o = c^.from (asCoord txt) + distance <- use (text . asText . before o . tillPrev (Y.toText pat) . to T.length .to negate) + return ((Offset $ distance + o)^.asCoord txt) + +-- | Move all ranges by the given number of columns +moveRangesByN :: Int -> BufAction () +moveRangesByN n = overRanges $ return . moveRangeByN n + +-- | Move all ranges by the given number of rows and columns +moveRangesByC :: Coord -> BufAction () +moveRangesByC c = overRanges $ return . moveRange c diff --git a/src/Rasa/Ext/Cursors/Internal/Base.hs b/src/Rasa/Ext/Cursors/Internal/Base.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Ext/Cursors/Internal/Base.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE TemplateHaskell, OverloadedStrings, Rank2Types #-} + +module Rasa.Ext.Cursors.Internal.Base + ( rangeDo + , rangeDo_ + , ranges + , eachRange + , overRanges + , addRange + , displayRange + ) where + + +import Rasa.Ext +import Rasa.Ext.Style + +import Control.Monad.State +import Control.Lens +import Data.Typeable +import Data.List +import Data.Default +import qualified Yi.Rope as Y + +-- | Stores the cursor ranges in each buffer. +data Cursors = Cursors + { _cursors :: [Range] + } deriving (Typeable, Show) +makeLenses ''Cursors + +instance Default Cursors where + def = Cursors { + _cursors=[Range (Coord 0 0) (Coord 0 1)] +} + +-- | Adjusts input ranges to contain at least one character. +ensureSize :: Range -> Range +ensureSize r@(Range s e) + | s == e = Range s (moveCursorByN 1 e) + | otherwise = r + +-- | Sorts Ranges, removes duplicates, ensures they contain at least one character +-- and restricts them to fit within the given text. +cleanRanges :: Y.YiString -> [Range] -> [Range] +cleanRanges txt = fmap (ensureSize . clampRange txt) . reverse . nub . sort + +-- | A lens over all the stored cursor ranges for a buffer +ranges :: HasBuffer s => Lens' s [Range] +ranges = lens getter setter + where getter buf = buf^.bufExt.cursors + setter buf new = let txt = buf^.text + in buf & bufExt.cursors .~ cleanRanges txt new + +-- | A Traversal over each Range for the given buffer. +eachRange :: HasBuffer s => Traversal' s Range +eachRange = ranges.traverse + +-- | Sequences actions over each range as a 'BufAction' +rangeDo :: (Range -> BufAction a) -> BufAction [a] +rangeDo f = use ranges >>= mapM f + +-- | 'rangeDo' with void return. +rangeDo_ :: (Range -> BufAction a) -> BufAction () +rangeDo_ = void . rangeDo + +-- | Sequences actions over each range and replaces each range with its result. +overRanges :: (Range -> BufAction Range) -> BufAction () +overRanges f = ranges <~ rangeDo f + +-- | Adds a new range to the list of ranges. +addRange :: Range -> BufAction () +addRange r = ranges <>= [r] + +-- | Sets style attributes to show a given range. +displayRange :: BufAction () +displayRange = rangeDo_ setStyle + where + setStyle :: Range -> BufAction () + setStyle r = addStyle r (flair ReverseVideo)