basis-library/mlton/io.fun

   1 (* Copyright (C) 2017 Matthew Fluet.
   2  * Copyright (C) 2002-2007 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 functor MLtonIO (S: MLTON_IO_ARG): MLTON_IO =
  10 struct
  11
  12 open S
  13
  14 fun mkstemps {prefix, suffix}: string * outstream =
  15    let
  16       fun loop () =
  17          let
  18             val name = concat [prefix, MLtonRandom.alphaNumString 6, suffix]
  19             open Posix.FileSys
  20          in
  21             (name,
  22              newOut (createf (name, O_WRONLY, O.flags [O.excl],
  23                               let open S
  24                               in flags [irusr, iwusr]
  25                               end),
  26                      name))
  27          end handle e as PosixError.SysErr (_, s) =>
  28             if s = SOME Posix.Error.exist
  29                then loop ()
  30             else raise e
  31    in
  32       loop ()
  33    end
  34
  35 fun mkstemp s = mkstemps {prefix = s, suffix = ""}
  36
  37 fun tempPrefix file =
  38    case MLtonPlatform.OS.host of
  39       MLtonPlatform.OS.MinGW =>
  40       (case MinGW.getTempPath () of
  41           SOME d => d
  42         | NONE => "C:\\temp\\") ^ file
  43     | _ => "/tmp/" ^ file
  44
  45 end