----------------------------------------------------------------------------- -- -- Module : Task.Modification -- Copyright : GPL v3 -- License : AllRightsReserved -- -- Maintainer : Ingolf Wagner -- Stability : experimental -- Portability : -- -- | This package contains all the manipulation you can do to the -- Task objects. -- ----------------------------------------------------------------------------- module Task.Modification where import Control.Arrow import Data.List import Task.Data -- | bread crumbs breadCrumbs :: Tasks -> [Task] breadCrumbs (Tasks _ ftasks) = map (\f -> focused f) ftasks -- | swap tasks on the actual path of the Tasks object swapTasks :: Int -> Int -> Tasks -> Tasks swapTasks a b tasks | a < 0 = tasks | b < 0 = tasks | a == b = tasks | a >= length (actual tasks) = tasks | b >= length (actual tasks) = tasks | otherwise = let t = actual tasks x = t !! a y = t !! b in if x == y then tasks else Tasks (map (\l -> if l == x then y else if l == y then x else l) t) (history tasks) -- | go into the children of some tasks goInto :: Task-> Tasks-> Tasks goInto task (Tasks ys xs) = let pos = task `elemIndex` ys elem = case pos of Nothing -> FTask task ys [] Just n -> FTask task (take n ys) (drop (n + 1) ys) in Tasks (children task) (elem:xs) -- | go out of actual task list and go one level up goOut :: Tasks -> Tasks goOut (Tasks a []) = Tasks a [] goOut (Tasks _ ((FTask a b c):xs)) = let actual = b ++ a:c rest = case xs of [] -> [] ((FTask n w v):ks) -> (FTask n { children = actual } w v):ks in Tasks actual rest -- | Add Task to Tasks addTask :: Task -> Tasks -> Tasks addTask t (Tasks a []) = Tasks (t:a) [] addTask t (Tasks a ((FTask parent b c):bs)) = Tasks (t:a) ((FTask parent { children = t:(children parent)} b c):bs) -- | Add Tasks to Tasks addTasks :: [Task] -> Tasks -> Tasks addTasks t (Tasks a []) = Tasks (t++a) [] addTasks t (Tasks a ((FTask parent b c):bs)) = Tasks (t ++ a) ((FTask parent { children = t ++ (children parent)} b c):bs) -- | removes Task from Tasks removeTask :: Int -> Tasks -> Tasks removeTask index tasks | index < 0 = tasks | index > (length $ actual tasks) = tasks | otherwise = let (ys,zs) = splitAt index (actual tasks) c = ys ++ (tail zs) rest = case (history tasks) of [] -> [] (FTask p x y):xs -> (FTask p { children = c } x y):xs in Tasks c rest -- | depth of the actual focused tasks 0 for top level depth :: Tasks -> Int depth (Tasks _ xs) = (length xs) - 1 -- | unrolls the tasks untill we have the toplevel asList :: Tasks -> [Task] asList = actual . unroll -- | unrolls the tasks untill we have the toplevel unroll :: Tasks -> Tasks unroll (Tasks a []) = Tasks a [] unroll f = unroll . goOut $ f