Commit 7fa74e04 authored by John van Groningen's avatar John van Groningen

use strict list functions from StdOverloadedList, remove rmStrictListIdx (use RemoveAt)

parent be61dc0c
......@@ -40,12 +40,6 @@ openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bo
// Save a project back to its project file
saveProject :: !FilePath !FilePath !Project !FilePath !*World -> *World
/*
Remove an item from a strict list at a given index. Abort execution if the
index is out of bounds.
*/
rmStrictListIdx :: !Int [!a!] -> [!a!]
/*
Move a path at a given index up or down the list of paths. Abort execution
if the index is out of bounds.
......
implementation module CpmLogic
/**
* Clean libraries imports
*/
import StdBool, StdEnum, StdMisc, StdTuple, StdArray, StdFunctions, StdStrictLists
from StdOverloadedList import ++|,Last,Init,RemoveAt,SplitAt,instance length [!!]
/**
* CPM imports
*/
......@@ -17,11 +23,6 @@ import Text
import Data.Func, Data.Error, Data.List
import System.Directory, System.File, System.FilePath
/**
* Clean libraries imports
*/
import StdBool, StdEnum, StdMisc, StdTuple, StdArray, StdFunc
/**
* Execute a general CPM action
*/
......@@ -237,10 +238,10 @@ withProject pwd pn cleanhome f world
*/
doProjectPathAction :: String String String Project PathAction *World -> *World
doProjectPathAction cleanhome pwd pn project (AddPathAction path) world
= doModPaths cleanhome pwd pn project ((:!) (GetLongPathName path)) world
= doModPaths cleanhome pwd pn project (\t -> [!GetLongPathName path:t!]) world
doProjectPathAction cleanhome pwd pn project (RemovePathAction i) world
= doModPaths cleanhome pwd pn project (rmStrictListIdx i) world
= doModPaths cleanhome pwd pn project (RemoveAt i) world
doProjectPathAction _ _ _ project ListPathsAction world
= showLines ["Paths for project:" : showPaths project] world
......@@ -260,8 +261,7 @@ doProjectPathAction _ _ _ _ _ world
* Collect all project paths in a list with an index prefixed
*/
showPaths :: !Project -> [String]
showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
where f (n, p) = " [" +++ toString n +++ "] " +++ p
showPaths project = [" [" +++ toString n +++ "] " +++ p \\ p<|-PR_GetPaths project & n<-[0..]]
/**
* Modify the list of paths in a project given a modification function which
......@@ -297,33 +297,24 @@ saveProject cleanhome pwd prj projectfile world
= error "Error saving project" world
= world
/**
* Remove an item from a strict list at a given index. Abort execution if the
* index is out of bounds.
*/
rmStrictListIdx :: !Int [!a!] -> [!a!]
rmStrictListIdx 0 (_ :! t) = t
rmStrictListIdx n (h :! t) | n > 0 = h :! (rmStrictListIdx (n - 1) t)
rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out of bounds")
/**
* Move a path at a given index up or down the list of paths. Abort execution
* if the index is out of bounds.
*/
moveStrictListIdx :: !Int PathDirection [!a!] -> [!a!]
moveStrictListIdx i dir xs
| i < 0 || i > (LLength xs - 1) = abort ("Index " +++ toString i +++ " out of bounds")
| otherwise = ListToStrictList (msl dir (splitAt i (StrictListToList xs)))
where msl MovePathUp ([], xs) = xs
msl MovePathUp (xs, [x:ys]) = (init xs) ++ [x : (last xs) : ys]
msl MovePathDown ([], [x:y:ys]) = [y:x:ys]
msl MovePathDown (xs, []) = xs
msl MovePathDown (xs, [y]) = xs ++ [y]
msl MovePathDown (xs, [x:y:ys]) = xs ++ [y:x:ys]
msl MovePathTop (xs, []) = xs
msl MovePathTop (xs, [y:ys]) = [y:xs] ++ ys
msl MovePathBottom (xs, []) = xs
msl MovePathBottom (xs, [y:ys]) = xs ++ ys ++ [y]
| i < 0 || i > length xs - 1 = abort ("Index " +++ toString i +++ " out of bounds")
| otherwise = msl dir (SplitAt i xs)
where msl MovePathUp ([!!], xs) = xs
msl MovePathUp (xs, [!x:ys!]) = Init xs ++| [!x : Last xs : ys!]
msl MovePathDown ([!!], [!x:y:ys!])= [!y:x:ys!]
msl MovePathDown (xs, [!!]) = xs
msl MovePathDown (xs, [!y!]) = xs ++| [!y!]
msl MovePathDown (xs, [!x:y:ys!]) = xs ++| [!y:x:ys!]
msl MovePathTop (xs, [!!]) = xs
msl MovePathTop (xs, [!y:ys!]) = [!y:xs++|ys!]
msl MovePathBottom (xs, [!!]) = xs
msl MovePathBottom (xs, [!y:ys!]) = xs ++| ys ++| [!y!]
/**
* Execute module-related actions
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment