module Data.Woot.Core
( integrate
, integrateAll
, makeDeleteOperation
, makeInsertOperation
) where
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Woot.Operation
import Data.Woot.WChar
import Data.Woot.WString
integrate :: Operation -> WString -> Maybe WString
integrate op ws =
if canIntegrate op ws
then Just $ integrateOp op ws
else Nothing
integrateAll :: [Operation] -> WString -> ([Operation], WString)
integrateAll ops ws =
if length ops == length newOps
then result
else integrateAll newOps newString
where
result@(newOps, newString) = foldl integrate' ([], ws) ops
integrate' (ops', s) op = maybe (ops' <> [op], s) (ops',) (integrate op s)
canIntegrate :: Operation -> WString -> Bool
canIntegrate (Operation Insert _ wc) ws = all (`contains` ws) [wCharPrevId wc, wCharNextId wc]
canIntegrate (Operation Delete _ wc) ws = contains (wCharId wc) ws
integrateOp :: Operation -> WString -> WString
integrateOp (Operation Insert _ wc) ws = integrateInsert (wCharPrevId wc) (wCharNextId wc) wc ws
integrateOp (Operation Delete _ wc) ws = integrateDelete wc ws
integrateInsert :: WCharId -> WCharId -> WChar -> WString -> WString
integrateInsert _ _ wc ws | contains (wCharId wc) ws = ws
integrateInsert prevId nextId wc ws = if isEmpty sub
then insert wc (fromJust $ indexOf nextId ws) ws
else compareIds $ fmap wCharId (toList sub) <> [nextId]
where
sub = subsection prevId nextId ws
compareIds :: [WCharId] -> WString
compareIds (wid:_) | wCharId wc < wid = insert wc (fromJust $ indexOf wid ws) ws
compareIds (_:wid:_) = integrateInsert wid nextId wc ws
compareIds _ = ws
integrateDelete :: WChar -> WString -> WString
integrateDelete wc = hideChar (wCharId wc)
makeDeleteOperation :: ClientId -> Int -> WString -> Maybe Operation
makeDeleteOperation cid pos ws = Operation Delete cid <$> nthVisible pos ws
makeInsertOperation :: WCharId -> Int -> Char -> WString -> Maybe Operation
makeInsertOperation (WCharId cid clock) pos a ws = Operation Insert cid <$> do
let numVis = length $ show ws
prev <- if pos == 0 then beginningChar else nthVisible (pos 1) ws
next <- if pos == numVis then endingChar else nthVisible pos ws
return $ WChar (WCharId cid clock) True a (wCharId prev) (wCharId next)
where
beginningChar = ws !? 0
endingChar = ws !? (lengthWS ws 1)