module Manatee.Action.BufferList where
import Data.Sequence (Seq)
import Manatee.Core.Types
import Manatee.Toolkit.Data.Unique
import Manatee.Toolkit.General.Map
import Manatee.Toolkit.General.Seq
import Manatee.Toolkit.General.String
import System.Posix.Types (ProcessID)
import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Sequence as Seq
bufferListReplacePath :: PageModeName -> PageId -> String -> BufferList -> BufferList
bufferListReplacePath pageModeName pageId newPath bl@(BufferList bufferMap) =
case bufferListGetBufferInfo pageModeName pageId bl of
Nothing -> bl
Just (oldBuffer, (bi, bufferSeq)) ->
let newBuffer = oldBuffer {bufferPath = newPath}
newBufferSeq = Seq.update bi newBuffer bufferSeq
in BufferList $ M.insert pageModeName newBufferSeq bufferMap
bufferListReplaceName :: PageModeName -> PageId -> String -> BufferList -> BufferList
bufferListReplaceName pageModeName pageId newTabName bl@(BufferList bufferMap) =
case bufferListGetBufferInfo pageModeName pageId bl of
Nothing -> bl
Just (oldBuffer, (bi, bufferSeq)) ->
let newBuffer = oldBuffer {bufferName = newTabName}
newBufferSeq = Seq.update bi newBuffer bufferSeq
in BufferList $ M.insert pageModeName newBufferSeq bufferMap
bufferListStripName :: PageModeName -> PageId -> String -> BufferList -> BufferList
bufferListStripName pageModeName pageId newPath bl@(BufferList bufferMap) =
case bufferListGetBufferInfo pageModeName pageId bl of
Nothing -> bl
Just (oldBuffer, (bi, bufferSeq)) ->
let newBuffer = oldBuffer {bufferName = stripFormat newPath 25}
newBufferSeq = Seq.update bi newBuffer bufferSeq
in BufferList $ M.insert pageModeName newBufferSeq bufferMap
bufferListUniqueName :: PageModeName -> BufferList -> BufferList
bufferListUniqueName modeName (BufferList bufferMap) =
let matchBuffer = findMinMatch bufferMap (\ mName _ -> mName == modeName)
in BufferList $
case matchBuffer of
Nothing -> bufferMap
Just (name, bufferSeq) ->
let buffers = F.toList bufferSeq
bufferPathList = map bufferPath buffers
newBuffers = map (\ (buffer, newName) ->
buffer {bufferName = newName}
) (zip buffers (map (uncurry formatBufferName) $ unique bufferPathList))
in M.insert name (Seq.fromList newBuffers) bufferMap
bufferListRemoveBuffer :: PageModeName -> Int -> BufferList -> BufferList
bufferListRemoveBuffer modeName index (BufferList bufferMap) =
BufferList $ M.filter (not . Seq.null)
$ M.mapWithKey
(\ pageModeName buffers ->
if pageModeName == modeName
then deleteAt index buffers
else buffers
) bufferMap
bufferListSwapBuffer :: PageModeName -> Int -> Int -> BufferList -> BufferList
bufferListSwapBuffer modeName currentIndex targetIndex (BufferList bufferMap) =
BufferList $ M.mapWithKey
(\ pageModeName buffers ->
if pageModeName == modeName
then swap currentIndex targetIndex buffers
else buffers
) bufferMap
bufferListAddBuffer :: (PageModeName, ProcessID, PageId, PageType, String) -> BufferList -> BufferList
bufferListAddBuffer (pageModeName, processId, pageId, pType, path) (BufferList bufferMap) =
let matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName)
newBuffer = Buffer processId pageId pType path ""
sequence = case matchBuffer of
Nothing -> Seq.singleton newBuffer
Just (_, seq) -> replaceOrAdd (\x -> bufferPageId x == pageId) newBuffer seq
in BufferList $ M.insert pageModeName sequence bufferMap
bufferListGetBufferIndex :: BufferList -> PageModeName -> FilePath -> Maybe Int
bufferListGetBufferIndex (BufferList bufferMap) pageModeName path = index
where matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName)
index = case matchBuffer of
Just (_, bufferSeq) -> Seq.findIndexL (\x -> bufferPath x == path) bufferSeq
Nothing -> Nothing
bufferListGetBufferIndexWithId :: BufferList -> PageModeName -> PageId -> Maybe Int
bufferListGetBufferIndexWithId (BufferList bufferMap) pageModeName pId = index
where matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName)
index = case matchBuffer of
Just (_, bufferSeq) -> Seq.findIndexL (\x -> bufferPageId x == pId) bufferSeq
Nothing -> Nothing
bufferListGetBufferInfo :: PageModeName -> PageId -> BufferList -> Maybe (Buffer, (Int, Seq Buffer))
bufferListGetBufferInfo pageModeName pageId (BufferList bufferMap) =
let matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName)
in case matchBuffer of
Nothing -> Nothing
Just (_, bufferSeq) ->
case Seq.findIndexL (\x -> bufferPageId x == pageId) bufferSeq of
Nothing -> Nothing
Just bi ->
let oldBuffer = Seq.index bufferSeq bi
in Just (oldBuffer, (bi, bufferSeq))
bufferListGetBuffer :: BufferList -> PageModeName -> PageId -> Maybe Buffer
bufferListGetBuffer bl pageModeName pId =
fmap fst (bufferListGetBufferInfo pageModeName pId bl)
formatBufferName :: FilePath -> FilePath -> FilePath
formatBufferName file dir
| null dir = file
| otherwise = file ++ "<" ++ dir ++ ">"
bufferListHaveBufferExist :: BufferList -> Bool
bufferListHaveBufferExist (BufferList bufferMap) =
not $ M.null bufferMap