fp2/week2/camil/StdIOMonad.icl

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