module Rasa.Internal.BufActions
( overRange
, replaceRange
, deleteRange
, insertAt
, sizeOf
, getLineRange
, bufDo
, bufDo_
, buffersDo
, buffersDo_
, getBufRefs
, nextBufRef
, prevBufRef
, getBufExt
, setBufExt
, overBufExt
, getBufRef
, getRange
, addBuffer
, getBuffer
, dispatchBufEvent
, addBufListener
, addBufListener_
, removeBufListener
, onBufAdded
, onBufAdded_
, dispatchBufAdded
, onEveryNewBuffer
, onEveryNewBuffer_
, onBufTextChanged
, dispatchBufTextChanged
, getText
) where
import Eve
import Rasa.Internal.Buffer
import Rasa.Internal.Range
import Rasa.Internal.Text
import Rasa.Internal.Events
import Control.Lens
import Control.Monad
import Data.Maybe
import Data.Default
import Data.Typeable
import qualified Yi.Rope as Y
import qualified Data.IntMap as IM
getText :: BufAction Y.YiString
getText = use text
getRange :: CrdRange -> BufAction Y.YiString
getRange rng = view (range rng) <$> getText
setRange :: CrdRange -> Y.YiString -> BufAction ()
setRange rng txt = do
text.range rng .= txt
dispatchBufTextChanged $ BufTextChanged rng txt
getBufRef :: BufAction BufRef
getBufRef = use ref
getBufExt :: (Typeable s, Show s, Default s) => BufAction s
getBufExt = use stateLens
setBufExt :: (Typeable s, Show s, Default s) => s -> BufAction ()
setBufExt newExt = stateLens .= newExt
overBufExt :: (Typeable s, Show s, Default s) => (s -> s) -> BufAction ()
overBufExt f = stateLens %= f
overRange :: CrdRange -> (Y.YiString -> Y.YiString) -> BufAction ()
overRange r f = getRange r >>= setRange r . f
deleteRange :: CrdRange -> BufAction ()
deleteRange r = replaceRange r ""
replaceRange :: CrdRange -> Y.YiString -> BufAction ()
replaceRange r txt = overRange r (const txt)
insertAt :: Coord -> Y.YiString -> BufAction ()
insertAt c = replaceRange r
where r = Range c c
type Row = Int
getLineRange :: Row -> BufAction (Maybe CrdRange)
getLineRange n = do
txt <- getText
let len = txt ^? asLines . ix n . to Y.length
return $ Range (Coord n 0) . Coord n <$> len
addBuffer :: Y.YiString -> App BufRef
addBuffer txt = do
bufId <- nextBufId <+= 1
let bufRef = BufRef bufId
buffers.at bufId ?= mkBuffer txt bufRef
dispatchBufAdded (BufAdded bufRef)
return bufRef
getBufRefs :: App [BufRef]
getBufRefs = fmap BufRef <$> use (buffers.to IM.keys)
getBuffer :: BufRef -> App (Maybe Buffer)
getBuffer (BufRef bufInd) =
use (buffers.at bufInd)
bufferDo :: [BufRef] -> BufAction r -> App [r]
bufferDo bufRefs bufAct = do
r <- forM bufRefs $ \(BufRef bInd) ->
runAction (buffers.at bInd._Just) ((:[]) <$> bufAct)
return $ concat r
buffersDo :: BufAction a -> App [a]
buffersDo bufAct = do
bufRefs <- getBufRefs
bufferDo bufRefs bufAct
buffersDo_ :: BufAction a -> App ()
buffersDo_ = void . buffersDo
bufDo :: BufRef -> BufAction a -> App (Maybe a)
bufDo bufRef bufAct = listToMaybe <$> bufferDo [bufRef] bufAct
bufDo_ :: BufRef -> BufAction a -> App ()
bufDo_ bufRef bufAct = void $ bufDo bufRef bufAct
nextBufRef :: BufRef -> App BufRef
nextBufRef br = do
bufRefs <- getBufRefs
return $ if null bufRefs
then br
else case dropWhile (<= br) bufRefs of
[] -> head bufRefs
(x:_) -> x
prevBufRef :: BufRef -> App BufRef
prevBufRef br = do
bufRefs <- getBufRefs
return $ if null bufRefs
then br
else case dropWhile (>= br) (reverse bufRefs) of
[] -> last bufRefs
(x:_) -> x
onBufAdded :: (BufAdded -> App result) -> App ListenerId
onBufAdded actionF = addListener (void . actionF)
onBufAdded_ :: (BufAdded -> App result) -> App ()
onBufAdded_ = void . onBufAdded
onEveryNewBuffer :: BufAction a -> App ListenerId
onEveryNewBuffer bufApp = onBufAdded $
\(BufAdded br) -> bufDo_ br bufApp
onEveryNewBuffer_ :: BufAction a -> App ()
onEveryNewBuffer_ = void . onEveryNewBuffer
dispatchBufAdded :: BufAdded -> App ()
dispatchBufAdded = dispatchEvent
onBufTextChanged :: (BufTextChanged -> BufAction result) -> BufAction ListenerId
onBufTextChanged bufAppF = addBufListener (void . bufAppF)
dispatchBufTextChanged :: BufTextChanged -> BufAction ()
dispatchBufTextChanged = dispatchBufEvent
dispatchBufEvent :: (Monoid result, Typeable eventType, Typeable result) => (eventType -> BufAction result)
dispatchBufEvent = dispatchEvent
addBufListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ListenerId
addBufListener = addListener
addBufListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ()
addBufListener_ = void . addBufListener
removeBufListener :: ListenerId -> BufAction ()
removeBufListener = removeListener