IOMonad.sml

(* const : 'a -> 'b -> 'a
 * Giver den konstante funktion der giver x. *)
fun const x _ = x

(* Lad os få os en IO monade så vi ikke skal se på alt det urene snask. *)
signature IOSig = sig
  type 'a io
  (* Monade operationer *)
  val >>= : 'a io -> ('a -> 'b io) -> 'b io
  val >> : 'a io -> 'b io -> 'b io
  (* Lazy return fordi vi ikke har doven evaluering og vi gerne vil kunne
   * vente med at evaluere noget til vi skal bruge det. *)
  val returnl : (unit -> 'a) -> 'a io

  (* *IO operationer *)
  val openIn : string -> TextIO.instream io
  val closeIn : TextIO.instream -> unit io

  val inputLine : TextIO.instream -> string option io

  val perform : 'a io -> 'a
end

structure IO :> IOSig = struct
local
  datatype 'a io = IO of (unit -> 'a)
  fun unwrap f x =
    let
      val (IO(ops)) = f x
    in
      ops ()
    end
in
  type 'a io = 'a io
  (* bind
   * >>= : 'a io -> ('a -> 'a io) -> 'b io *)
  fun >>= (IO(ops)) (ioOp) =
    IO((unwrap ioOp) o ops)
  (* append
   * >> : 'a io -> 'b io -> 'b io*)
  fun >> (IO(ops1)) (IO(ops2)) =
    IO(ops2 o (ignore o ops1))
  (* return : (unit -> a) -> m a*)
  fun returnl v =
    IO(v)

  fun openIn f =
    returnl (fn () => TextIO.openIn f)
  fun closeIn strm =
    returnl (fn () => TextIO.closeIn strm)
  fun inputLine strm =
    returnl (fn () => TextIO.inputLine strm)

  fun perform (IO(ops)) =
    ops ()
end
end

(* Monade operationer *)
infix 1 >>=
fun ma >>= f = IO.>>= ma f
infix 1 >>
fun ma >> mb = IO.>> ma mb

fun returnl x = IO.returnl x
fun return x = IO.returnl (const x)