Commit 0791628d authored by Jeroen Henrix's avatar Jeroen Henrix

New modules:

- Data.Error (MaybeError type)
- System.FilePath (Filename and directory name operations)
- System.File (readFile, writeFile)
- System.OSError (reporting Win API error codes and -messages)
- System.Pointer
- System.Process (Run processes)

Changed:
- Added == instance for Maybe

git-svn-id: https://svn.cs.ru.nl/repos/clean-platform/trunk@56 2afc29ad-3112-4e41-907a-9359c7e6e986
parent d1dccb86
......@@ -21,6 +21,7 @@ Environments
Path: {Application}\Platform\src\libraries\OS-Windows\System
Path: {Application}\Platform\src\libraries\OS-Windows\Database
Path: {Application}\Platform\src\libraries\OS-Windows\Database\SQL
Path: {Application}\Platform\src\libraries\OS-Windows-32\System
EnvironmentCompiler: Tools\Clean System\CleanCompiler.exe
EnvironmentCodeGen: Tools\Clean System\CodeGenerator.exe
EnvironmentLinker: Tools\Clean System\StaticLinker.exe
......
module ProcessDemo
import StdEnv
import Environment
import FilePath
import File
import Process
Start world
# (mTemp, world) = getEnvironmentVariable "TEMP" world
| isNothing mTemp = ("TEMP environment variable not found", world)
# textfile = fromJust mTemp </> "hello.txt"
# (res, world) = writeFile textfile "Hello, World!" world
| isError res = ("Failed to write file: " +++ toString (fromError res), world)
# (mWindir, world) = getEnvironmentVariable "windir" world
| isNothing mWindir = ("windir environment variable not found", world)
# editor = fromJust mWindir </> "notepad.exe"
# (res, world) = callProcess editor [textfile] Nothing world
| isError res = ("Failed to run process: " +++ snd (fromError res), world)
# (res, world) = readFile textfile world
| isError res = ("Failed to read file: " +++ toString (fromError res), world)
# contents = fromOk res
# (res, world) = deleteFile textfile world
| isError res = ("Failed to delete file: " +++ snd (fromError res), world)
= (contents, world)
definition module Error
:: MaybeError a b = Ok a | Error b
:: MaybeErrorString a :== MaybeError a String
/**
* Return True when the argument is an Ok value and return False otherwise.
*/
isOk :: !(MaybeError a b) -> Bool
/**
* Return True when the argument is an Error value and return False otherwise.
*/
isError :: !(MaybeError a b) -> Bool
/**
* Return the contents of an Ok value and abort at run-time otherwise.
*/
fromOk :: !(MaybeError a b) -> a
/**
* Return the contents of an Error value and abort at run-time otherwise.
*/
fromError :: !(MaybeError a b) -> b
/**
* Lifts a (MaybeError a b) to another MaybeError
* @precondition: isError x == True
*/
liftError :: !(MaybeError a b) -> (MaybeError c b)
implementation module Error
import StdMisc
isOk :: !(MaybeError a b) -> Bool
isOk (Ok _) = True
isOk (Error _) = False
isError :: !(MaybeError a b) -> Bool
isError (Ok _) = False
isError (Error _) = True
fromOk :: !(MaybeError a b) -> a
fromOk (Ok a) = a
fromOk (Error _) = abort "Data.Error.fromOk: argument is Error"
fromError :: !(MaybeError a b) -> b
fromError (Error b) = b
fromError (Ok _) = abort "Data.Error.fromError: argument is Ok"
liftError :: !(MaybeError a b) -> (MaybeError c b)
liftError (Error b) = Error b
liftError (Ok _) = abort "Data.Error.liftError: argument is Ok"
definition module Maybe
import StdBool
import StdFunc
import StdMisc
from StdOverloaded import class ==(..)
/**
* The Maybe type represents an optional value by providing a constructor
......@@ -11,12 +8,16 @@ import StdMisc
*/
:: Maybe a = Nothing | Just a
/**
* Apply a function to the contents of a Just value, if such a value is present.
*/
fmap :: (.a -> .b) (Maybe .a) -> Maybe .b
/**
* Equality on Maybes:
*/
instance == (Maybe x) | == x
/**
* Apply a function to the the contents of a Just value and directly return
* the result, or return a default value if the argument is a Nothing value.
......
......@@ -11,6 +11,14 @@ fmap :: (.a -> .b) (Maybe .a) -> Maybe .b
fmap _ Nothing = Nothing
fmap f (Just x) = Just (f x)
instance == (Maybe x) | == x where
(==) Nothing maybe = case maybe of
Nothing -> True
just -> False
(==) (Just a) maybe = case maybe of
Just b -> a==b
nothing -> False
maybe :: .b (.a -> .b) !(Maybe .a) -> .b
maybe x _ Nothing = x
maybe _ f (Just x) = f x
......
definition module FilePath
/**
Module for manipulation of file and directory paths
*/
:: FilePath :== String
/**
* Returns the default platform path separator
*/
pathSeparator :: Char
/**
* Returns a list of all allowed platform path separators
*/
pathSeparators :: [Char]
/**
* Returns the default file extension separator
*/
extSeparator :: Char
/**
* Concatenates two paths
*/
(</>) infixr 5 :: !FilePath !FilePath -> FilePath
/**
* Split a FilePath into filename and extension. The result does not include the extension separator (.).
*/
splitExtension :: !FilePath -> (String, String)
/**
* Take the extension of a FilePath, excluding the separator
*/
takeExtension :: !FilePath -> String
/**
* Remove the extension and extension separator of a FilePath
*/
dropExtension :: !FilePath -> String
/**
* Add an extension to a FilePath
*/
addExtension :: !FilePath !String -> FilePath
/**
* Replace the extension of a FilePath
*/
replaceExtension :: !FilePath !String -> FilePath
/**
* Take the directory part of a FilePath. If the FilePath is a directory,
* the result is the parent directory.
*/
takeDirectory :: !FilePath -> FilePath
\ No newline at end of file
implementation module FilePath
import StdArray
import StdList
import StdTuple
import StdString
import FilePath
import Text
pathSeparator :: Char
pathSeparator = '\\'
pathSeparators :: [Char]
pathSeparators = ['\\', '/']
extSeparator :: Char
extSeparator = '.'
(</>) infixr 5 :: !FilePath !FilePath -> FilePath
(</>) x y = (addTrailingPathSeparator x) +++ y
splitExtension :: !FilePath -> (String, String)
splitExtension path =
case lastIndexOf {extSeparator} path of
-1 -> (path, "")
i -> (subString 0 i path, subString (i+1) (size path - i - 1) path)
takeExtension :: !FilePath -> String
takeExtension path = snd (splitExtension path)
dropExtension :: !FilePath -> String
dropExtension path = fst (splitExtension path)
addExtension :: !FilePath !String -> FilePath
addExtension path "" = path
addExtension path ext | path.[size path - 1] == extSeparator = path +++ ext
addExtension path ext = path +++ {extSeparator} +++ ext
replaceExtension :: !FilePath !String -> FilePath
replaceExtension path ext = addExtension (dropExtension path) ext
hasTrailingPathSeparator :: !FilePath -> Bool
hasTrailingPathSeparator path = isMember (path.[size path - 1]) pathSeparators
addTrailingPathSeparator :: !FilePath -> FilePath
addTrailingPathSeparator path = if (hasTrailingPathSeparator path) path (path +++ {pathSeparator})
splitFileName :: !FilePath -> (String, String)
splitFileName path =
case lastIndexOf {pathSeparator} path of
-1 -> (path, "")
i -> (subString 0 i path, subString (i+1) (size path - i - 1) path)
takeDirectory :: !FilePath -> FilePath
takeDirectory path = fst (splitFileName path)
\ No newline at end of file
kernel32.dll
CloseHandle@4
CreateFileA@28
DeleteFileA@4
FindClose@4
FindFirstFileA@8
FormatMessageA@28
GetEnvironmentVariableA@12
GetExitCodeProcess@8
GetLastError@0
LocalFree@4
SetEnvironmentVariableA@8
WaitForSingleObject@8
definition module _WinBase
import _WinDef
/*
* Record definitions, size and field offsets
*/
:: LPSECURITY_ATTRIBUTES :== Int
:: LPSTARTUPINFO :== {#Int}
STARTUPINFO_size_bytes :== 68
STARTUPINFO_size_int :== 17
STARTUPINFO_cb_int_offset :== 0
STARTUPINFO_dwFlags_int_offset :== 11
STARTUPINFO_hStdError_int_offset :== 16
:: LPWIN32_FIND_DATA :== {#Int}
WIN32_FIND_DATA_size_bytes :== 320
WIN32_FIND_DATA_size_int :== 80
:: LPPROCESS_INFORMATION :== {#Int}
PROCESS_INFORMATION_size_bytes :== 32
PROCESS_INFORMATION_size_int :== 4
PROCESS_INFORMATION_hProcess_int_offset :== 0
PROCESS_INFORMATION_hThread_int_offset :== 1
/*
* Macros
*/
DETACHED_PROCESS :== 8
FORMAT_MESSAGE_ALLOCATE_BUFFER :== 0x00000100
FORMAT_MESSAGE_FROM_SYSTEM :== 0x00001000
FORMAT_MESSAGE_IGNORE_INSERTS :== 0x00000200
INFINITE :== 0xFFFFFFFF
LANGUAGE_NEUTRAL_SUBLANG_DEFAULT :== 0x400
STARTF_USESTDHANDLES :== 0x00000100
STATUS_PENDING :== 0x00000103
STILL_ACTIVE :== STATUS_PENDING
WAIT_ABANDONED_0 :== 0x80
WAIT_FAILED :== 0xFFFFFFFF
WAIT_OBJECT_0 :== 0
WAIT_TIMEOUT :== 258
/*
* Windows API calls
*/
closeHandle :: !HANDLE !*World -> (!Bool,!*World)
createFileA :: !LPCTSTR !DWORD !DWORD !LPSECURITY_ATTRIBUTES
!DWORD !DWORD !HANDLE !*World -> (!Bool, !*World)
createProcessA :: !String !String !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!LPCTSTR !LPSTARTUPINFO !LPPROCESS_INFORMATION !*World -> (!Bool,!*World)
createProcessA_dir :: !String !String !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!String !LPSTARTUPINFO !LPPROCESS_INFORMATION !*World -> (!Bool,!*World)
deleteFile :: !String !*World -> (!Int, !*World)
findClose :: !HANDLE !*World -> (!Bool, !*World)
findFirstFileA :: !String !LPWIN32_FIND_DATA !*World -> (!HANDLE, !*World)
formatMessage :: !DWORD !LPCVOID !DWORD !DWORD !{#LPTSTR} !DWORD !Int -> DWORD
getExitCodeProcess :: !HANDLE !*World -> (!Bool,!Int,!*World);
getLastError :: !*World -> (!Int, !*World)
localFree :: !HLOCAL -> HLOCAL
waitForSingleObject :: !HANDLE !Int !*World -> (!Int,!*World);
implementation module _WinBase
import _WinDef
import code from library "_WinBase_library";
closeHandle :: !HANDLE !*World -> (!Bool,!*World)
closeHandle handle world
= code {
ccall CloseHandle@4 "PI:I:I"
}
createFileA :: !LPCTSTR !DWORD !DWORD !LPSECURITY_ATTRIBUTES !DWORD !DWORD !HANDLE !*World -> (!Bool, !*World)
createFileA lpFileName dwDesiredAccess dwShareMode lpSecurityAttributes
dwCreationDisposition dwFlagsAndAttributes hTemplateFile world
= code {
ccall CreateFile@28 "PsIIAIII:I:I"
}
createProcessA :: !String !String !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!LPCTSTR !LPSTARTUPINFO !LPPROCESS_INFORMATION !*World -> (!Bool,!*World)
createProcessA lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
currentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PssIIIIIIAA:I:I"
}
createProcessA_dir :: !String !String !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!String !LPSTARTUPINFO !LPPROCESS_INFORMATION !*World -> (!Bool,!*World)
createProcessA_dir lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
currentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PssIIIIIsAA:I:I"
}
deleteFile :: !String !*World -> (!Int, !*World)
deleteFile path world = code inline {
ccall DeleteFileA@4 "Ps:I:I"
}
findClose :: !HANDLE !*World -> (!Bool, !*World)
findClose handle world
= code {
ccall FindClose@4 "PI:I:I"
}
findFirstFileA :: !String !LPWIN32_FIND_DATA !*World -> (!HANDLE, !*World)
findFirstFileA filename win32FindData world
= code {
ccall FindFirstFileA@8 "PsA:I:I"
}
formatMessage :: !DWORD !LPCVOID !DWORD !DWORD !{#LPTSTR} !DWORD !Int -> DWORD
formatMessage dwFlags lpSource dwMessageId dwLanguageId lpBuffer nSize args =
code {
ccall FormatMessageA@28 "PIIIIAII:I"
}
getExitCodeProcess :: !HANDLE !*World -> (!Bool,!Int,!*World);
getExitCodeProcess handle world
= code {
ccall GetExitCodeProcess@8 "PI:II:I"
}
getLastError :: !*World -> (!Int, !*World)
getLastError world =
code {
ccall GetLastError@0 "P:I:A"
}
localFree :: !HLOCAL -> HLOCAL
localFree hMem =
code {
ccall LocalFree@4 "PI:I"
}
waitForSingleObject :: !HANDLE !Int !*World -> (!Int,!*World);
waitForSingleObject handle timeout world
= code {
ccall WaitForSingleObject@8 "PpI:I:I"
}
definition module _WinDef
:: HANDLE :== Int
:: DWORD :== Int
:: LPCTSTR :== Int
:: LPTSTR :== Int
:: LPVOID :== Int
:: LPCVOID :== Int
:: HLOCAL :== HANDLE
INVALID_HANDLE_VALUE :== -1
NULL :== 0
definition module File
from StdFile import class FileSystem
from StdClass import class toString
import Error
import Void
import OSError
:: FileError = CannotOpen | CannotClose | IOError
instance toString FileError
/**
* Given a filename, reads the contents of the file to a String
* @param Path to the file to read
* @return contents of the file
*/
readFile :: !String *env -> (MaybeError String FileError, *env) | FileSystem env
/**
* Read all contents of a *File to a String.
* @precondition The file must be opened in read mode
* @param Path to the file to read
* @return contents of the file
*/
readAll :: *File -> (MaybeError String FileError, *File)
/**
* writes a string to a file
* @param Path to the file to read
* @param contents of the file
*/
writeFile :: !String !String *env -> (MaybeError Void FileError, *env) | FileSystem env
/**
* Performs a file operation on a given filename.
* The file is opened and closed by the withFile function.
* @param Path to the file
* @param file operation function
* @return file operation result
*/
withFile :: !String Int (*File -> (MaybeError a FileError,*File)) *env
-> (MaybeError a FileError, *env) | FileSystem env
/**
* checks if a file exists
* @param Path to the file
* @return file exists
*/
fileExists :: !String *World -> (Bool, *World)
/**
* deletes a file from disk
* @param Path to the file
* @return delete succeeded
*/
deleteFile :: !String *World -> (MaybeOSError Void, *World)
implementation module File
//StdEnv
import StdArray
import StdFile
import StdList
import StdString
import Error
import Void
import OSError
import Pointer
CHUNK_SIZE :== 1024
from _Windows import
::HANDLE,
:: LPWIN32_FIND_DATA,
WIN32_FIND_DATA_size_int,
findFirstFileA,
INVALID_HANDLE_VALUE,
findClose
from _Windows import qualified deleteFile
instance toString FileError
where
toString CannotOpen = "Cannot open"
toString CannotClose = "Cannot close"
toString IOError = "I/O error"
readFile :: !String *env -> (MaybeError String FileError, *env) | FileSystem env
readFile filename env = withFile filename FReadData readAll env
readAll :: *File -> (MaybeError String FileError, *File)
readAll file
# (result, file) = readAcc file []
= case result of
Error e = (Error e, file)
Ok contents = (Ok ((foldr (+++) "" (reverse contents))), file)
where
readAcc :: *File [String] -> (MaybeError [String] FileError, *File)
readAcc file acc
# (str,file) = freads file CHUNK_SIZE
# (err,file) = ferror file
| err = (Error IOError,file)
# (eof,file) = fend file
| eof = (Ok [str:acc],file)
| otherwise = readAcc file [str:acc]
writeFile :: !String !String *env -> (MaybeError Void FileError, *env) | FileSystem env
writeFile filename contents env =
withFile filename FWriteData (\file -> (Ok Void, fwrites contents file)) env
withFile :: !String Int (*File -> (MaybeError a FileError,*File)) *env
-> (MaybeError a FileError, *env) | FileSystem env
withFile filename filemode operation env
# (ok,file,env) = fopen filename filemode env
| not ok = (Error CannotOpen, env)
# (result,file) = operation file
| isError result = (result, env)
# (ok,env) = fclose file env
| not ok = (Error CannotClose, env)
= (Ok (fromOk result), env)
fileExists :: !String *World -> (Bool, *World)
fileExists filename world
# win32FindData = createArray WIN32_FIND_DATA_size_int 0
# (handle, world) = findFirstFileA (packString filename) win32FindData world
| handle == INVALID_HANDLE_VALUE = (False, world)
# (_,world) = findClose handle world
= (True, world)
deleteFile :: !String *World -> (MaybeOSError Void, *World)
deleteFile path world
# (ok, world) = '_Windows'.deleteFile path world
| ok == 0 = getLastOSError world
= (Ok Void, world)
definition module FilePath
/**
Module for manipulation of file and directory paths
*/
:: FilePath :== String
pathSeparator :: Char
pathSeparators :: [Char]
extSeparator :: Char
(</>) infixr 5 :: !FilePath !FilePath -> FilePath
splitExtension :: !FilePath -> (String, String)
takeExtension :: !FilePath -> String
dropExtension :: !FilePath -> String
addExtension :: !FilePath !String -> FilePath
replaceExtension :: !FilePath !String -> FilePath
takeDirectory :: !FilePath -> FilePath
\ No newline at end of file
implementation module FilePath
import StdArray
import StdList
import StdTuple
import StdString
import FilePath
import Text
pathSeparator :: Char
pathSeparator = '\\'
pathSeparators :: [Char]
pathSeparators = ['\\', '/']
extSeparator :: Char
extSeparator = '.'