______________
[fp1415.git] / fp2 / week2 / mart / StdIOMonad.icl
index 1d4b24e..b0f2b4f 100644 (file)
@@ -2,15 +2,123 @@ implementation module StdIOMonad
 \r
 //     Deze module verpakt StdFile in een monadische jas\r
 \r
+import StdBool\r
+import StdEnum\r
 import StdFile\r
+import StdList\r
+import StdMaybe\r
+import StdMisc\r
 import StdMonad\r
-//import StdOverloaded\r
+import StdOverloaded\r
+import StdString\r
+import StdTuple\r
 \r
-:: IO a = IO [a]       // kies een geschikte representatie voor IO\r
+:: IO a = IO (*W -> *(a, *W))\r
+:: *W :== *(*World, *[*(Filehandle, *File)])\r
 :: Filemode = Lees | Schrijf\r
 :: Filenaam :== String\r
-:: Filehandle :== []   // kies een geschikte representatie voor Filehandle\r
+:: Filehandle :== String\r
 \r
-//instance toInt Filemode where\r
-//     toInt Lees                                              = FReadText\r
-//     toInt Schrijf                                   = FWriteText\r
+instance toInt Filemode where\r
+       toInt Lees = FReadText\r
+       toInt Schrijf = FWriteText\r
+\r
+//voer monadische I/O actie uit op de wereld:\r
+doIO:: (IO a) *World -> *(a, *W)\r
+doIO (IO f) w = f (w, [])\r
+\r
+unIO:: (IO a) -> *W -> *(a, *W)\r
+unIO (IO f) = f \r
+\r
+//  IO is een monad:\r
+instance return IO where\r
+       return x = IO (\w -> (x, w))\r
+instance >>=    IO where\r
+       (>>=) (IO f) g = IO (\w = let (a, w1) = f w in unIO (g a) w1)\r
+\r
+//Start world = doIO (read >>= (\w = return w)) (world, "")\r
+//Start world = doIO (open "camilt.txt" Lees) (world, "")\r
+//Start world = doIO (read >>= (\w = read)) (world, "")\r
+\r
+read:: IO String\r
+read = IO read`\r
+       where\r
+               read`:: *W -> *(String, *W)\r
+               read` (world, s)\r
+               # (io, world) = stdio world\r
+               # (line, io) = freadline io\r
+               # (_, world) = fclose io world\r
+               = (line, (world, s))\r
+\r
+//     schrijf regel naar de console:\r
+write          :: String -> IO Void\r
+write s = IO (write` s)\r
+       where\r
+               write`:: String *W -> *(Void, *W)\r
+               write` line (world, s)\r
+               # (io, world) = stdio world\r
+               # io = io <<< line\r
+               # (_, world) = fclose io world\r
+               = (Void, (world, s))\r
+\r
+\r
+Start world = doIO (\r
+       open "camil.txt" Lees >>= \r
+       \y = eof "camil.txt") world\r
+\r
+//     open de file met gegeven filenaam en mode:\r
+find:: Filehandle *[*(Filehandle, *File)] -> (Maybe *(Filehandle, *File), *[*(Filehandle, *File)]) \r
+find fh fs\r
+# (fhs, fis) = unzip fs\r
+# fhsC = zip2 [0..length fhs] fhs\r
+# index = [(i, h) \\ (i, h) <- fhsC | h == fh]\r
+| length index == 0 = (Nothing, zip2 fhs fis)\r
+# index = fst (hd index)\r
+# (fis1, fis2) = splitAt index fis\r
+# (fhs1, fhs2) = splitAt index fhs\r
+# (thefile, fis2) = splitAt 1 fis2\r
+# (thehandle, fhs2) = splitAt 1 fhs2\r
+= (Just (hd thehandle, hd thefile), zip2 (fhs1 ++ fhs2) (fis1 ++ fis2))\r
+\r
+\r
+open:: Filenaam Filemode -> IO (Maybe Filehandle)\r
+open s m = IO (open` s m)\r
+       where\r
+               open`:: String Filemode *W -> *(Maybe Filehandle, *W)\r
+               open` fp m (world, fs)\r
+               | any (\l = fp == fst l) fs = (Nothing, (world, fs))\r
+               # (ok, file, world) = fopen fp (toInt m) world\r
+               = (Just fp, (world, [(fp, file):fs]))\r
+\r
+//     sluit de file met gegeven filenaam:\r
+close:: Filehandle -> IO Bool\r
+close fh = IO (close` fh)\r
+       where\r
+               close`:: Filehandle *W -> *(Bool, *W)\r
+               close` fp (world, fs)\r
+               # (currentfiletuple, fs) = find fp fs\r
+               | isNothing currentfiletuple = (False, (world, fs))\r
+               # (currentfh, currentfile) = fromJust currentfiletuple\r
+               # (ok, world) = fclose currentfile world\r
+               | not ok = abort "File can't be closed"\r
+               | otherwise = (True, (world, fs))\r
+               \r
+\r
+//     bepaal of het lezen van de file klaar is:\r
+eof                    :: Filehandle -> IO Bool\r
+eof fh = IO (eof` fh)\r
+       where \r
+               eof`:: Filehandle *W -> *(Bool, *W)\r
+               eof` fp (world, fs)\r
+               # (currentfiletuple, fs) = find fp fs\r
+               | isNothing currentfiletuple = abort "Can't do eof on non-existing file"\r
+               # (currentfh, currentfile) = fromJust currentfiletuple\r
+               # (ok, file) = fend currentfile\r
+               = (ok, (world, [(currentfh, file):fs]))\r
+\r
+//     lees een regel van een file:\r
+//readline     :: Filehandle -> IO (Maybe String)\r
+\r
+\r
+//     schrijf een regel naar een file:\r
+writeline      :: String Filehandle -> IO Bool\r