fp2/week2/mart/oldold/old/StdIOMonad.icl

   1 implementation module StdIOMonad
   2
   3 //Deze module verpakt StdFile in een monadische jas
   4
   5 import StdFile
   6 import StdMonad
   7 import StdMaybeMonad
   8
   9
  10 :: IO a = IO (*World Filehandle -> *(a, *World, Filehandle))
  11 :: Void       = Void
  12 :: Filemode   = Lees | Schrijf
  13 :: Filenaam :== String
  14 :: *Filehandle = None | FH *(Bool, Filemode, *File)
  15
  16 toInt :: Filemode -> Int
  17 toInt Lees = FReadText
  18 toInt Schrijf = FWriteText
  19
  20 Start world = read
  21
  22 ////voer monadische I/O actie uit op de wereld:
  23 //doIO :: (IO a) *World -> *(a,*World)
  24 //doIO (IO f) world = f (world, Closed)
  25
  26 //  IO is een monad:
  27 instance return IO where
  28         return x = IO (\w fh = (x, w, fh))
  29 //instance >>=    IO where
  30 //      (>>=) (IO f) g = IO(\w = let (a, w1) = f w in doIO (g a) w1)
  31
  32 //lees regel van de console:
  33 read:: IO String
  34 read = IO (\w fh -> ("", w, fh))
  35
  36 /*//schrijf regel naar de console:
  37 write:: String -> IO Void
  38 write s = IO (\w = (Void, write` s w))
  39         where
  40                 write`:: String *World -> *World
  41                 write` s world
  42                 # (io, world) = stdio world
  43                 # io = fwrites s world
  44                 # (_, world) = fclose io
  45                 = world
  46
  47 //open de file met gegeven filenaam en mode:
  48 open:: Filenaam Filemode -> IO (Maybe Filehandle)
  49 open s m = IO (\w = let (f1, w1) = openfh` s m w in (f1, (w1, f1)))
  50         where
  51                 openfh`:: Filenaam Filemode *World -> (Maybe Filehandle, *World)
  52                 openfh` s m world
  53                 # (ok, file, world) = fopen s (toInt m) world
  54                 | ok = (Just (Open (m, file)), world)
  55                 | otherwise = (Nothing, world)
  56
  57 //sluit de file met gegeven filenaam:
  58 close:: Filehandle -> IO Bool
  59 close fh = IO (\w = let (b1, w1) = close` fh w in (b1, (w1, Closed)))
  60         where
  61                 close`:: Filehandle *World -> (Bool, *World)
  62                 close` Closed world = (False, world)
  63                 close` (Open (_, file)) world = fclose file world
  64
  65 //bepaal of het lezen van de file klaar is:
  66 eof:: Filehandle -> IO Bool
  67 eof fh = IO (\w = let (b1, w1) = eof` fh w in (b1, (w1, Closed)))
  68         where
  69                 eof`:: Filehandle *World -> (Bool, *World)
  70                 eof` Closed world = (world, False)
  71                 eaf`(Open (_, file)) world = fclose file
  72
  73 //lees een regel van een file:
  74 readline:: Filehandle -> IO (Maybe String)
  75 readline fh = IO (\w = let r1 = readline` fh w in r1)
  76         where
  77                 readline`:: Filehandle *World -> (Maybe String, (*World, Filehandle))
  78                 readline` Closed world = (world, Nothing)
  79                 readline` (Open (Schrijf, _)) world = (world, Nothing)
  80                 readline` (Open (Lees, file)) world
  81                 # (line, file) = sfreadline file
  82                 = (Just line, (world, Open (Lees, file)))
  83
  84 //schrijf een regel naar een file:
  85 writeline:: String Filehandle -> IO Bool
  86 writeline s fh = IO (\w = let r1 = writeline` s fh w in r1)
  87         where
  88                 writeline`:: String Filehandle *World -> (Bool, (*World, Filehandle))
  89                 writeline` line Closed world = (False, (world, Closed))
  90                 writeline` line (Open (Lees, file)) world = (False, (world, (Open (Lees, file))))
  91                 writeline` line (Open (Schrijf, file)) world
  92                 # file = fwrites line file
  93                 = (True, (world, file))*/