From a7d7542dc646a5fd124ef71e71ce260889f1701b Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Tue, 2 Feb 2016 19:24:50 +0100
Subject: Moved to 1415 directory

---
 1415/fp2/week2/mart/StdIOMonad.icl | 138 +++++++++++++++++++++++++++++++++++++
 1 file changed, 138 insertions(+)
 create mode 100644 1415/fp2/week2/mart/StdIOMonad.icl

(limited to '1415/fp2/week2/mart/StdIOMonad.icl')

diff --git a/1415/fp2/week2/mart/StdIOMonad.icl b/1415/fp2/week2/mart/StdIOMonad.icl
new file mode 100644
index 0000000..ffa2857
--- /dev/null
+++ b/1415/fp2/week2/mart/StdIOMonad.icl
@@ -0,0 +1,138 @@
+implementation module StdIOMonad
+
+import StdBool
+import StdEnum
+import StdFile
+import StdList
+import StdMaybe
+import StdMisc
+import StdMonad
+import StdOverloaded
+import StdString
+import StdTuple
+
+:: IO a = IO (*W -> *(a, *W))
+:: *W :== *(*World, *[*(Filehandle, *File)])
+:: Filemode = Lees | Schrijf
+:: Filenaam :== String
+:: Filehandle :== String
+
+// Conversion from our filemodes to StdFile filemodes
+instance toInt Filemode where
+	toInt Lees = FReadText
+	toInt Schrijf = FWriteText
+
+// Apply the monadic program on the world
+doIO:: (IO a) *World -> *(a, *W)
+doIO (IO f) w = f (w, [])
+
+// Lift the value out of the monadic domain
+unIO:: (IO a) -> *W -> *(a, *W)
+unIO (IO f) = f 
+
+instance return IO where
+	return x = IO (\w -> (x, w))
+instance >>=    IO where
+	(>>=) (IO f) g = IO (\w = let (a, w1) = f w in unIO (g a) w1)
+
+// Read one line from the console
+read:: IO String
+read = IO read`
+	where
+		read`:: *W -> *(String, *W)
+		read` (world, s)
+		# (io, world) = stdio world
+		# (line, io) = freadline io
+		# (_, world) = fclose io world
+		= (line, (world, s))
+
+// Write a line from the console
+write		:: String -> IO Void
+write s = IO (write` s)
+	where
+		write`:: String *W -> *(Void, *W)
+		write` line (world, s)
+		# (io, world) = stdio world
+		# io = io <<< line
+		# (_, world) = fclose io world
+		= (Void, (world, s))
+
+// Open a file
+open:: Filenaam Filemode -> IO (Maybe Filehandle)
+open s m = IO (open` s m)
+	where
+		open`:: String Filemode *W -> *(Maybe Filehandle, *W)
+		open` fp m (world, fs)
+		| any (\l = fp == fst l) fs = (Nothing, (world, fs))
+		# (ok, file, world) = fopen fp (toInt m) world
+		= (Just fp, (world, [(fp, file):fs]))
+
+// Close a file. If the file can't be closed by the system the program will
+// abort
+close:: Filehandle -> IO Bool
+close fh = IO (close` fh)
+	where
+		close`:: Filehandle *W -> *(Bool, *W)
+		close` fp (world, fs)
+		# (currentfiletuple, fs) = getFH fp fs
+		| isNothing currentfiletuple = (False, (world, fs))
+		# (currentfh, currentfile) = fromJust currentfiletuple
+		# (ok, world) = fclose currentfile world
+		| not ok = abort "File can't be closed"
+		| otherwise = (True, (world, fs))
+		
+
+// Determine if the file is at the end. This will abort when the file is not
+// open or error if the file is not opened for reading.
+eof			:: Filehandle -> IO Bool
+eof fh = IO (eof` fh)
+	where 
+		eof`:: Filehandle *W -> *(Bool, *W)
+		eof` fp (world, fs)
+		# (currentfiletuple, fs) = getFH fp fs
+		| isNothing currentfiletuple = abort "Can't do eof on non-existing file"
+		# (currentfh, currentfile) = fromJust currentfiletuple
+		# (ok, file) = fend currentfile
+		= (ok, (world, [(currentfh, file):fs]))
+
+// Read one line from a file (including newline). This will abort when the file
+// is not open or error if the file is not opened for reading.
+readline	:: Filehandle -> IO (Maybe String)
+readline fh = IO (readline` fh)
+	where
+		readline` :: Filehandle *W -> *(Maybe String, *W)
+		readline` fh (world, fs)
+		# (currentfiletuple, fs) = getFH fh fs
+		| isNothing currentfiletuple = abort "File not open"
+		# (currentfh, currentfile) = fromJust currentfiletuple
+		# (s, currentfile) = freadline currentfile
+		= (Just s, (world, [(currentfh, currentfile):fs]))
+
+// Write one line from a file (will not append newline). This will abort when
+// the file is not open or error if the file is not opened for writing.
+writeline	:: String Filehandle -> IO Bool
+writeline s fh = IO (writeline` s fh)
+	where
+		writeline` :: String Filehandle *W -> *(Bool, *W)
+		writeline` s fh (world, fs)
+		# (currentfiletuple, fs) = getFH fh fs
+		| isNothing currentfiletuple = abort "File not open"
+		# (currentfh, currentfile) = fromJust currentfiletuple
+		# currentfile = fwrites s currentfile
+		= (True, (world, [(currentfh, currentfile):fs]))
+
+// Gets the file associated with the filehandle given, this is done in a very
+// ugly way to retain uniqueness...
+getFH:: Filehandle *[*(Filehandle, *File)] ->
+	(Maybe *(Filehandle, *File), *[*(Filehandle, *File)]) 
+getFH fh fs
+# (fhs, fis) = unzip fs
+# fhsC = zip2 [0..length fhs] fhs
+# index = [(i, h) \\ (i, h) <- fhsC | h == fh]
+| length index == 0 = (Nothing, zip2 fhs fis)
+# index = fst (hd index)
+# (fis1, fis2) = splitAt index fis
+# (fhs1, fhs2) = splitAt index fhs
+# (thefile, fis2) = splitAt 1 fis2
+# (thehandle, fhs2) = splitAt 1 fhs2
+= (Just (hd thehandle, hd thefile), zip2 (fhs1 ++ fhs2) (fis1 ++ fis2))
-- 
cgit v1.2.3