fp2/week2/mart/StdIOMonad.icl

   1 implementation module StdIOMonad
   2
   3 //      Deze module verpakt StdFile in een monadische jas
   4
   5 import StdBool
   6 import StdEnum
   7 import StdFile
   8 import StdList
   9 import StdMaybe
  10 import StdMisc
  11 import StdMonad
  12 import StdOverloaded
  13 import StdString
  14 import StdTuple
  15
  16 :: IO a = IO (*W -> *(a, *W))
  17 :: *W :== *(*World, *[*(Filehandle, *File)])
  18 :: Filemode = Lees | Schrijf
  19 :: Filenaam :== String
  20 :: Filehandle :== String
  21
  22 instance toInt Filemode where
  23         toInt Lees = FReadText
  24         toInt Schrijf = FWriteText
  25
  26 //voer monadische I/O actie uit op de wereld:
  27 doIO:: (IO a) *World -> *(a, *W)
  28 doIO (IO f) w = f (w, [])
  29
  30 unIO:: (IO a) -> *W -> *(a, *W)
  31 unIO (IO f) = f
  32
  33 //  IO is een monad:
  34 instance return IO where
  35         return x = IO (\w -> (x, w))
  36 instance >>=    IO where
  37         (>>=) (IO f) g = IO (\w = let (a, w1) = f w in unIO (g a) w1)
  38
  39 //Start world = doIO (read >>= (\w = return w)) (world, "")
  40 //Start world = doIO (open "camilt.txt" Lees) (world, "")
  41 //Start world = doIO (read >>= (\w = read)) (world, "")
  42
  43 read:: IO String
  44 read = IO read`
  45         where
  46                 read`:: *W -> *(String, *W)
  47                 read` (world, s)
  48                 # (io, world) = stdio world
  49                 # (line, io) = freadline io
  50                 # (_, world) = fclose io world
  51                 = (line, (world, s))
  52
  53 //      schrijf regel naar de console:
  54 write           :: String -> IO Void
  55 write s = IO (write` s)
  56         where
  57                 write`:: String *W -> *(Void, *W)
  58                 write` line (world, s)
  59                 # (io, world) = stdio world
  60                 # io = io <<< line
  61                 # (_, world) = fclose io world
  62                 = (Void, (world, s))
  63
  64
  65 Start world = doIO (
  66         open "camil.txt" Lees >>=
  67         \y = eof "camil.txt") world
  68
  69 //      open de file met gegeven filenaam en mode:
  70 find:: Filehandle *[*(Filehandle, *File)] -> (Maybe *(Filehandle, *File), *[*(Filehandle, *File)])
  71 find fh fs
  72 # (fhs, fis) = unzip fs
  73 # fhsC = zip2 [0..length fhs] fhs
  74 # index = [(i, h) \\ (i, h) <- fhsC | h == fh]
  75 | length index == 0 = (Nothing, zip2 fhs fis)
  76 # index = fst (hd index)
  77 # (fis1, fis2) = splitAt index fis
  78 # (fhs1, fhs2) = splitAt index fhs
  79 # (thefile, fis2) = splitAt 1 fis2
  80 # (thehandle, fhs2) = splitAt 1 fhs2
  81 = (Just (hd thehandle, hd thefile), zip2 (fhs1 ++ fhs2) (fis1 ++ fis2))
  82
  83
  84 open:: Filenaam Filemode -> IO (Maybe Filehandle)
  85 open s m = IO (open` s m)
  86         where
  87                 open`:: String Filemode *W -> *(Maybe Filehandle, *W)
  88                 open` fp m (world, fs)
  89                 | any (\l = fp == fst l) fs = (Nothing, (world, fs))
  90                 # (ok, file, world) = fopen fp (toInt m) world
  91                 = (Just fp, (world, [(fp, file):fs]))
  92
  93 //      sluit de file met gegeven filenaam:
  94 close:: Filehandle -> IO Bool
  95 close fh = IO (close` fh)
  96         where
  97                 close`:: Filehandle *W -> *(Bool, *W)
  98                 close` fp (world, fs)
  99                 # (currentfiletuple, fs) = find fp fs
 100                 | isNothing currentfiletuple = (False, (world, fs))
 101                 # (currentfh, currentfile) = fromJust currentfiletuple
 102                 # (ok, world) = fclose currentfile world
 103                 | not ok = abort "File can't be closed"
 104                 | otherwise = (True, (world, fs))
 105
 106
 107 //      bepaal of het lezen van de file klaar is:
 108 eof                     :: Filehandle -> IO Bool
 109 eof fh = IO (eof` fh)
 110         where
 111                 eof`:: Filehandle *W -> *(Bool, *W)
 112                 eof` fp (world, fs)
 113                 # (currentfiletuple, fs) = find fp fs
 114                 | isNothing currentfiletuple = abort "Can't do eof on non-existing file"
 115                 # (currentfh, currentfile) = fromJust currentfiletuple
 116                 # (ok, file) = fend currentfile
 117                 = (ok, (world, [(currentfh, file):fs]))
 118
 119 //      lees een regel van een file:
 120 //readline      :: Filehandle -> IO (Maybe String)
 121
 122
 123 //      schrijf een regel naar een file:
 124 writeline       :: String Filehandle -> IO Bool