From df21921cd35e39a55da8ffe2db8bfd415ea1fadd Mon Sep 17 00:00:00 2001 From: Phil Date: Mon, 22 Aug 2016 10:05:10 +0100 Subject: [PATCH 01/20] Added mapConcurrently function, like mapM but performs each action in parallel --- src/NovelIO/IO.fs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index bf72113..cd438d0 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -295,6 +295,14 @@ module IO = with | :? SuccessException<'b> as ex -> Some <| ex.Value) + /// mapConcurrently is similar to mapM but where each of the IO actions in the sequence are performed in parallel + let mapConcurrently f seq = + fromEffectful (fun _ -> + seq + |> Array.ofSeq + |> Array.Parallel.map (run << (flip bind) f) + |> Seq.ofArray) + /// Module to provide the definition of the io computation expression [] module IOBuilders = From 20fd3c6f82d46b1702cdd92915dd00119b315f20 Mon Sep 17 00:00:00 2001 From: Phil Date: Mon, 22 Aug 2016 10:43:15 +0100 Subject: [PATCH 02/20] Filename becomes FilePath, this resolves an issue where files in other folders have unsupported names Added tests for some of the untested prelude functions --- src/NovelIO/File.fs | 22 +++++++------- src/NovelIO/Prelude.fs | 38 +++++++++++++------------ tests/NovelIO.UnitTests/FileTests.fs | 8 +++--- tests/NovelIO.UnitTests/PreludeTests.fs | 12 ++++++++ 4 files changed, 47 insertions(+), 33 deletions(-) diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index 44db42b..099e5d6 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -21,7 +21,7 @@ open System.IO /// Side effecting File IO functions used to implement the pure versions module private SideEffectingFileIO = /// Gets the bare string from a filename - let toFileInfo (filename : Filename) = FileInfo(filename.PathString) + let toFileInfo (filename : FilePath) = FileInfo(filename.PathString) /// Returns true if the file is readonly, false otherwise let isFileReadOnly file = (toFileInfo file).IsReadOnly @@ -32,7 +32,7 @@ module private SideEffectingFileIO = |> LanguagePrimitives.Int64WithMeasure /// Create a file channel for a supplied file name, file mode and file access - let openTextFileChannel (fName : Filename) mode access = + let openTextFileChannel (fName : FilePath) mode access = let crTxtRdr (fStream : FileStream) = new StreamReader(fStream) let crTxtWrtr (fStream : FileStream) = new StreamWriter(fStream) let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) @@ -44,7 +44,7 @@ module private SideEffectingFileIO = {TextReader = reader; TextWriter = writer} /// Create a binary file channel for a supplied file name, file mode and file access - let openBinaryFileChannel (fName : Filename) mode access = + let openBinaryFileChannel (fName : FilePath) mode access = let crBinRdr (fStream : FileStream) = new BinaryReader(fStream) let crBinWrtr (fStream : FileStream) = new BinaryWriter(fStream) let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) @@ -61,11 +61,11 @@ module File = /// Throws an ArgumentException if the supplied string is, in fact, not valid. let assumeValidFilename path = match path with - |ValidFilename fname -> fname - |InvalidFilename -> invalidArg "path" "Assumption of valid path was not correct." + |ValidFilePath fname -> fname + |InvalidFilePath -> invalidArg "path" "Assumption of valid path was not correct." /// Gets the bare string from a filename - let getPathString (filename : Filename) = filename.PathString + let getPathString (filename : FilePath) = filename.PathString /// Appends lines to a file, and then closes the file. If the specified file does not exist, this function creates a /// file, writes the specified lines to the file and then closes the file. @@ -117,19 +117,19 @@ module File = IO.fromEffectful (fun _ -> File.Move(getPathString sourceFile, getPathString destFile)) /// Opens a channel to the specified file using the supplied file mode - let openBinaryChannel mode access (fName : Filename) = + let openBinaryChannel mode access (fName : FilePath) = IO.fromEffectful (fun _ -> SideEffectingFileIO.openBinaryFileChannel fName mode access) /// Opens a channel to the specified file using the supplied file mode and performs the supplied computation fChannel with the channel before cleaning it up. - let withBinaryChannel mode access (fName : Filename) fChannel = + let withBinaryChannel mode access (fName : FilePath) fChannel = IO.bracket (openBinaryChannel mode access fName) (BinaryChannel.close) fChannel /// Opens a channel to the specified file using the supplied file mode - let openTextChannel mode access (fName : Filename) = + let openTextChannel mode access (fName : FilePath) = IO.fromEffectful (fun _ -> SideEffectingFileIO.openTextFileChannel fName mode access) /// Opens a channel to the specified file using the supplied file mode and performs the supplied computation fChannel with the channel before cleaning it up. - let withTextChannel mode access (fName : Filename) fChannel = + let withTextChannel mode access (fName : FilePath) fChannel = IO.bracket (openTextChannel mode access fName) (TextChannel.close) fChannel /// Reads all the bytes from a specified file as an array @@ -181,5 +181,5 @@ module File = IO.fromEffectful (fun _ -> SideEffectingFileIO.fileSize filename) /// Creates a new file, writes the specified lines to the file and then closes the file. - let writeLines (lines : seq) (filename : Filename) = + let writeLines (lines : seq) (filename : FilePath) = IO.fromEffectful (fun _ -> File.WriteAllLines(filename.PathString, lines)) \ No newline at end of file diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index ba90ea4..4f8e589 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -61,32 +61,34 @@ and IOErrorResult = /// Units of bytes [] type Bytes -/// Represents a filename of a valid format -type Filename = - private |Filename of string - +/// Represents a filename in a valid format +type FilePath private (fName : string) = + let fInfo = System.IO.FileInfo(fName) /// The raw string representation of the filename - member this.PathString = match this with Filename str -> str - - /// Attempts to create a valid filename from a string, returning Some Filename if successful or None otherwise - static member TryCreateFromString (path : string) = - match path.IndexOfAny(Path.GetInvalidFileNameChars()) = -1 with - |true -> Some <| Filename(path) - |false -> None + member this.PathString = fName /// Attempts to create a valid filename from a string, returning a Filename if successful or throwing an exception otherwise static member CreateFromString path = - match Filename.TryCreateFromString path with - |Some fname -> fname - |None -> invalidArg "path" "Path Invalid" + Some <| FilePath path + + /// Attempts to create a valid filename from a string, returning Some Filename if successful or None otherwise + static member TryCreateFromString (path : string) = + try + FilePath.CreateFromString path + with + | :? System.Security.SecurityException -> None + | :? System.ArgumentException -> None + | :? System.UnauthorizedAccessException -> None + | :? System.IO.PathTooLongException -> None + | :? System.NotSupportedException -> None /// Provides patterns for matching against valid and invalid file names [] module PathDiscriminators = - let (|ValidFilename|InvalidFilename|) (path : string) = - match Filename.TryCreateFromString path with - |Some fname -> ValidFilename fname - |None -> InvalidFilename + let (|ValidFilePath|InvalidFilePath|) (path : string) = + match FilePath.TryCreateFromString path with + |Some fname -> ValidFilePath fname + |None -> InvalidFilePath /// General functions of wide applicability [] diff --git a/tests/NovelIO.UnitTests/FileTests.fs b/tests/NovelIO.UnitTests/FileTests.fs index b6122d1..12e2dd1 100644 --- a/tests/NovelIO.UnitTests/FileTests.fs +++ b/tests/NovelIO.UnitTests/FileTests.fs @@ -47,16 +47,16 @@ type ``File Unit Tests``() = static member ``ValidFilename path disciminator matches for a valid file path``() = let fnameStr = System.IO.Path.GetRandomFileName() match fnameStr with - |ValidFilename fname -> true - |InvalidFilename -> failwith "path was expected not be invalid" + |ValidFilePath fname -> true + |InvalidFilePath -> failwith "path was expected not be invalid" [] static member ``InvalidFilename path disciminator matches for a invalid file path``() = let invStr = string << Array.head <| System.IO.Path.GetInvalidFileNameChars() let fnameStr = System.IO.Path.GetRandomFileName() + invStr match fnameStr with - |ValidFilename fname -> failwith "path was invalid" - |InvalidFilename -> true + |ValidFilePath fname -> failwith "path was invalid" + |InvalidFilePath -> true [] static member ``Function: getPathString returns contained path string``() = diff --git a/tests/NovelIO.UnitTests/PreludeTests.fs b/tests/NovelIO.UnitTests/PreludeTests.fs index b936d27..51e88ad 100644 --- a/tests/NovelIO.UnitTests/PreludeTests.fs +++ b/tests/NovelIO.UnitTests/PreludeTests.fs @@ -36,3 +36,15 @@ type ``Prelude Unit Tests``() = static member ``ByteOrder.systemEndianness returns the endianness of the current system`` () = ByteOrder.isBigEndian (ByteOrder.systemEndianness) <> System.BitConverter.IsLittleEndian + [] + static member ``listCons is equivalent to a::b`` (a : int, b : int list) = + listCons a b = a :: b + + [] + static member ``curry f(x, y) a b = f' a b `` (f : int * int -> int, a : int, b : int) = + curry f a b = f(a, b) + + [] + static member ``uncurry f a b = f'(a, b) `` (f : int -> int -> int, a : int, b : int) = + uncurry f (a, b) = f a b + From 3a3ff2c515d4d7a869b45861e416a88b41aaa6be Mon Sep 17 00:00:00 2001 From: Phil Date: Mon, 29 Aug 2016 15:04:37 +0100 Subject: [PATCH 03/20] Experimental support added for asynchronous IO via the AsyncIO case in the IO type. Synchronous and Asynchronous IO can now be combined within the same overall structure. Sychronous IO will be used for memory streams and small reads from the file system while Async IO will be used for large file system reads and remote reads. --- src/NovelIO/BinaryPickler.fs | 22 +-- src/NovelIO/Channels.fs | 151 ++++++++++----- src/NovelIO/File.fs | 21 +-- src/NovelIO/IO.fs | 193 ++++++++++++-------- src/NovelIO/MemoryBuffer.fs | 12 +- src/NovelIO/PicklerInfrastructure.fs | 4 +- src/NovelIO/Prelude.fs | 19 +- src/NovelIO/TCP.fs | 37 ++-- tests/NovelIO.IntegrationTests/FileTests.fs | 17 -- 9 files changed, 279 insertions(+), 197 deletions(-) diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index be49fd6..b0604f4 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -56,7 +56,7 @@ module BinaryPickler = match st with |PickleComplete ps -> PickleComplete {ps with Raw = (PickleConvertors.arrayFlipToList << f <| b) @ ps.Raw} |PickleIncremental ips -> - ips.Writer.Write (f b) + BinaryChannel.SideEffecting.write (f b) ips.Writer st /// Helper function that chooses between complete or incremental unpickling and accepts an arbitrary data-size let private unpickleHelperSized size f st = @@ -66,7 +66,7 @@ module BinaryPickler = let result = f pos (ps.Raw) result, UnpickleComplete {ps with Position = pos + size} |UnpickleIncremental ips -> - let result = f 0 (ips.Reader.ReadBytes size) + let result = f 0 (BinaryChannel.SideEffecting.readExactly size ips.Reader) result, st /// Helper function that chooses between complete or incremental unpickling and gets the size from the size of the data type @@ -464,22 +464,22 @@ module BinaryPickler = /// Uses the supplied pickler/unpickler pair (PU) to unpickle from the supplied binary channel incrementally let unpickleIncr pu binaryChannel = - match binaryChannel.BinaryReader with - |Some binReader -> - let incrUnpickler = UnpickleIncremental {Reader = binReader} + match binaryChannel.IOStream.CanRead with + |true -> + let incrUnpickler = UnpickleIncremental {Reader = binaryChannel} IO.fromEffectful (fun _ -> fst <| runUnpickle (incrUnpickler) pu) - |None -> raise ChannelDoesNotSupportReadingException + |false -> raise ChannelDoesNotSupportReadingException /// Uses the supplied pickler/unpickler pair (PU) to pickle the supplied data to the supplied binary channel incrementally let pickleIncr pu binaryChannel value = - match binaryChannel.BinaryWriter with - |Some binWriter -> - let incrPickler = PickleIncremental {Writer = binWriter} + match binaryChannel.IOStream.CanWrite with + |true -> + let incrPickler = PickleIncremental {Writer = binaryChannel} IO.fromEffectful (fun _ -> match (runPickle (value, incrPickler) pu) with - |PickleIncremental ps -> binWriter.Flush() + |PickleIncremental ps -> binaryChannel.IOStream.Flush() |_ -> invalidOp "A non-incremental binary pickler state was returned from an initially incremental pickler") - |None -> raise ChannelDoesNotSupportReadingException + |false -> raise ChannelDoesNotSupportReadingException diff --git a/src/NovelIO/Channels.fs b/src/NovelIO/Channels.fs index 65a830f..15d6ecb 100644 --- a/src/NovelIO/Channels.fs +++ b/src/NovelIO/Channels.fs @@ -41,6 +41,11 @@ module TextChannel = match channel.TextReader with |Some txtRdr -> txtRdr.ReadLine() |None -> raise ChannelDoesNotSupportReadingException + /// Gets a line from a text channel asynchronously + let getLineAsync channel = + match channel.TextReader with + |Some txtRdr -> async { return! Async.AwaitTask <| txtRdr.ReadLineAsync()} + |None -> raise ChannelDoesNotSupportReadingException /// Writes a string to a text channel let putStr (str : string) channel = putStrF (fun txtWrtr -> txtWrtr.Write str) channel @@ -62,7 +67,10 @@ module TextChannel = let close channel = IO.fromEffectful (fun _ -> SideEffecting.close channel) /// An action that reads a line from the text channel - let getLine channel = IO.fromEffectful (fun _ -> SideEffecting.getLine channel) + let getLine (channel : TChannel) = + match channel.IOMode with + |Synchronous -> IO.fromEffectful (fun _ -> SideEffecting.getLine channel) + |_ -> IO.liftAsync <| SideEffecting.getLineAsync channel /// An action that determines if the text channel is at the end of the stream. This a synonym for isEOF let isEOS channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelAtEndOfStream channel) @@ -78,65 +86,112 @@ module TextChannel = /// Operations on binary channels module BinaryChannel = - module private SideEffecting = + module internal SideEffecting = /// Close a binary channel - let close channel = - match channel.BinaryReader with - |Some binRdr -> binRdr.Close() - |None -> () - match channel.BinaryReader with - |Some binWtr -> binWtr.Close() - |None -> () - /// Determines whether a supplied binary channel is ready to be read from - let isChannelReadyToRead channel = - match channel.BinaryReader with - |Some binRdr -> binRdr.PeekChar() <> -1 - |None -> raise ChannelDoesNotSupportReadingException + let close bChannel = bChannel.IOStream.Close() /// Sets the absolute position of the binary channel - let setAbsPosition pos bChannel = - match bChannel.BinaryReader with - |Some br -> br.BaseStream.Position <- pos - |_ -> () - match bChannel.BinaryWriter with - |Some bw -> bw.BaseStream.Position <- pos - |_ -> () - /// Reads from the binary channel with a supplied function - let read f bChannel = - match bChannel.BinaryReader with - |Some bRdr -> f bRdr - |None -> raise ChannelDoesNotSupportReadingException - /// Writes to the binary channel with a supplied function - let write f bChannel = - match bChannel.BinaryWriter with - |Some bWrtr -> f bWrtr - |None -> raise ChannelDoesNotSupportWritingException + let setAbsPosition pos bChannel = bChannel.IOStream.Position <- pos + + /// Reads from the binary channel + let read bytes pos count bChannel = + match bChannel.IOStream.CanRead with + |true -> + let read = bChannel.IOStream.Read(bytes, pos, count) + if (read = 0) then bChannel.EOS <- true + read + |false -> raise ChannelDoesNotSupportReadingException + + /// Reads from the binary channel + let readExactly count bChannel = + let bytes = Array.zeroCreate count + let mutable readCount = 0 + while readCount < count do + let justRead = read bytes readCount (count-readCount) bChannel + if justRead = 0 then raise <| System.IO.EndOfStreamException() + readCount <- readCount + justRead + bytes + + /// Reads asynchronously from the binary channel + let asyncRead bytes pos count bChannel = + async { + match bChannel.IOStream.CanRead with + |true -> + let! read = bChannel.IOStream.AsyncRead(bytes, pos, count) + if (read = 0) then bChannel.EOS <- true + return read + |false -> return! raise ChannelDoesNotSupportReadingException + } + + /// Reads asynchronously from the binary channel + let asyncReadExactly count bChannel = + async { + match bChannel.IOStream.CanRead with + |true -> return! bChannel.IOStream.AsyncRead(count) + |false -> return! raise ChannelDoesNotSupportReadingException + } + + /// Writes to the binary channel + let write bytes bChannel = + match bChannel.IOStream.CanWrite with + |true -> bChannel.IOStream.Write(bytes, 0, bytes.Length) + |false -> raise ChannelDoesNotSupportWritingException + + /// Writes asynchronously to the binary channel + let asyncWrite bytes bChannel = + async { + match bChannel.IOStream.CanWrite with + |true -> return! bChannel.IOStream.AsyncWrite(bytes, 0, bytes.Length) + |false -> return! raise ChannelDoesNotSupportWritingException + } + + /// Higher order function for performing channel actions synchrously or asynchronously + let private syncOrAsync syncFunc asyncA count channel = + match channel.IOMode with + |Synchronous | Optimise when count < 1024 -> IO.fromEffectful syncFunc + |_ -> IO.liftAsync asyncA + + /// Provides a general approach for reading partial byte arrays from a channel + let private readPartialByteArray channel count = + // function to synchronously read a partial byte array + let syncFunc () = + let bytes = Array.zeroCreate count + let count' = SideEffecting.read bytes 0 count channel + Array.take count' bytes + // async action to read partial byte array + let asyncA = + async { + let bytes = Array.zeroCreate count + let! count' = SideEffecting.asyncRead bytes 0 count channel + return Array.take count' bytes + } + syncOrAsync syncFunc asyncA count channel + + /// Provides a general approach for reading complete byte arrays from a channel + let private readCompleteByteArray channel count = + let syncFunc() = SideEffecting.readExactly count channel + let asyncA = SideEffecting.asyncReadExactly count channel + syncOrAsync syncFunc asyncA count channel /// An action that closes a binary channel let close channel = IO.fromEffectful (fun _ -> SideEffecting.close channel) - /// An action that determines if the binary channel has data available - let isReady channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelReadyToRead channel) + /// Determines if the end of the channel has been reached + let isEOS channel = IO.fromEffectful (fun _ -> channel.EOS) - /// Channel reading partial byte arrays in different ways - let private readPartialByteArray channel count f = - IO.fromEffectful (fun _ -> - let bytes = Array.zeroCreate count - let count' = SideEffecting.read (fun br -> br.Read(bytes, 0, count)) channel - f count' bytes) + /// Determines if the end of the channel has been reached + let isEOF channel = isEOS channel /// An action that reads up to a specified number of bytes from a channel and returns the result as a byte array - let readBytes channel maxCount = - readPartialByteArray channel maxCount (Array.take) + let read channel maxCount = readPartialByteArray channel maxCount - /// An action that attempts to read a fixed number of bytes from a channel and returns Some(byte array) if it succeeds or None if it can't satisfy the request. - let readFixedBytes channel count = - readPartialByteArray channel count (fun count' bytes -> - match count = count' with - |true -> Some bytes - |false -> None) + /// An action that reads exactly count bytes from a channel and throws an exception if the end of the stream is reached + let readExactly channel count = readCompleteByteArray channel count /// An action that sets the position of the binary channel to the supplied absolute position let setAbsPosition channel pos = IO.fromEffectful (fun _ -> SideEffecting.setAbsPosition pos channel) /// An action that writes a supplied array of bytes to the binary channel - let writeBytes channel (bytes : byte[]) = IO.fromEffectful (fun _ -> SideEffecting.write (fun bw -> bw.Write bytes) channel) \ No newline at end of file + let writeBytes channel (bytes : byte[]) = + let sync() = SideEffecting.write bytes channel + let asyncA = SideEffecting.asyncWrite bytes channel + syncOrAsync sync asyncA (bytes.Length) channel \ No newline at end of file diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index 099e5d6..bc6678c 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -35,25 +35,18 @@ module private SideEffectingFileIO = let openTextFileChannel (fName : FilePath) mode access = let crTxtRdr (fStream : FileStream) = new StreamReader(fStream) let crTxtWrtr (fStream : FileStream) = new StreamWriter(fStream) - let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) + let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access, FileShare.Read, 4096, true) let (reader, writer) = match access with |NovelFS.NovelIO.FileAccess.Read -> Some <| crTxtRdr fStream, None |NovelFS.NovelIO.FileAccess.ReadWrite -> Some <| crTxtRdr fStream, Some <| crTxtWrtr fStream |NovelFS.NovelIO.FileAccess.Write -> None, Some <| crTxtWrtr fStream - {TextReader = reader; TextWriter = writer} + {TextReader = reader; TextWriter = writer; IOMode = Optimise} /// Create a binary file channel for a supplied file name, file mode and file access let openBinaryFileChannel (fName : FilePath) mode access = - let crBinRdr (fStream : FileStream) = new BinaryReader(fStream) - let crBinWrtr (fStream : FileStream) = new BinaryWriter(fStream) let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) - let (reader, writer) = - match access with - |NovelFS.NovelIO.FileAccess.Read -> Some <| crBinRdr fStream, None - |NovelFS.NovelIO.FileAccess.ReadWrite -> Some <| crBinRdr fStream, Some <| crBinWrtr fStream - |NovelFS.NovelIO.FileAccess.Write -> None, Some <| crBinWrtr fStream - {BinaryReader = reader; BinaryWriter = writer} + {IOStream = fStream; IOMode = Optimise; EOS = false} /// Provides functions relating to the creating, copying, deleting, moving, opening and reading of files module File = @@ -144,14 +137,6 @@ module File = let readAllLinesIn encoding filename = IO.fromEffectful (fun _ -> List.ofArray <| File.ReadAllLines (getPathString filename, Encoding.createDotNetEncoding encoding)) - /// Reads the lines from a file where each line can be read lazily. - let readLines filename = - IO.fromEffectful (fun _ -> Seq.map (IO.return') (File.ReadLines <| getPathString filename)) - - /// Reads lines from a file in the supplied encoding where each line can be read lazily. - let readLinesIn encoding filename = - IO.fromEffectful (fun _ -> Seq.map (IO.return') (File.ReadLines (getPathString filename, Encoding.createDotNetEncoding encoding))) - /// Sets the date / time at which the specified file was created let setCreationTime datetime filename = IO.fromEffectful (fun _ -> File.SetCreationTime(getPathString filename, datetime)) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index cd438d0..4aaae2f 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -23,29 +23,48 @@ open System.Net type IO<'a> = private |Return of 'a - |Delay of (unit -> 'a) + |SyncIO of (unit -> IO<'a> ) + |AsyncIO of (Async>) /// Pure IO Functions module IO = // ------- RUN ------- // - /// Runs the IO actions and evaluates the result - let run io = + let rec private runIO io = + match io with + |Return a -> a + |SyncIO (f) -> runIO <| f() + |AsyncIO a -> runIO << Async.RunSynchronously <| a + + let rec private runAsyncIO io = match io with - |Return a -> a - |Delay (a) -> a() + |Return a -> async.Return a + |SyncIO f -> runAsyncIO <| f() + |AsyncIO a -> async.Bind (a, runAsyncIO) + + /// Runs the IO actions and evaluates the result + let run io = runIO io // ------- MONAD ------- // /// Return a value as an IO action let return' x = Return x + /// Creates an IO action from an effectful computation, this simply takes a side effecting function and brings it into IO - let fromEffectful f = Delay (f) + let fromEffectful f = SyncIO (fun () -> return' <| f()) + /// Monadic bind for IO action, this is used to combine and sequence IO actions let bind x f = - match x with - |Return a -> f a - |Delay (g) -> Delay (fun _ -> run << f <| g()) + let rec bindRec x' = + match x' with + |Return a -> f a + |SyncIO (g) -> SyncIO (fun () -> bindRec <| g()) + |AsyncIO (a) -> AsyncIO (async.Bind(a, async.Return << bindRec)) + bindRec x + + /// Lift an async computation into IO + let liftAsync a = AsyncIO <| async.Bind(a, async.Return << Return) + /// Removes a level of IO structure let join x = bind x id @@ -87,7 +106,7 @@ module IO = let apply (f : IO<'a -> 'b>) (x : IO<'a>) = bind f (fun fe -> map fe x) - /// Lift a value. + /// Lift a value into IO. Equivalent to return. let pure' x = Return x // ------- OPERATORS ------- // @@ -135,9 +154,20 @@ module IO = // run recursively and channel exceptions in IO InternalIOHelper.withExceptionCheck (run) io - /// Sparks off a new thread to run the IO action passed as the first argument - let forkIO io = - fromEffectful (fun _ -> System.Threading.Tasks.Task.Factory.StartNew(fun () -> run io) |> ignore) + /// Allows a supplied IO action to be executed on the thread pool, returning a task from which you can + /// observe the result + let forkTask<'a> (io : IO<'a>) = + fromEffectful (fun _ -> + match io with + |Return a -> System.Threading.Tasks.Task.FromResult(a) + |SyncIO act -> System.Threading.Tasks.Task.Run(fun _ -> run io) + |AsyncIO aIO -> Async.StartAsTask <| runAsyncIO io) + + /// Allows a supplied IO action to be executed on the thread pool + let forkIO<'a> (io : IO<'a>) = map (ignore) (forkTask io) + + /// Allows the awaiting of a result from a forked Task + let awaitTask task = liftAsync <| Async.AwaitTask task /// Map each element of a list to a monadic action, evaluate these actions from left to right and collect the results as a sequence. let mapM mFunc sequ = @@ -169,16 +199,13 @@ module IO = Seq.foldBack (f') sequ return' acc /// Evaluate each action in the sequence from left to right and collect the results as a sequence. - let sequence seq = - mapM id seq + let sequence seq = mapM id seq /// Performs the action mFunc n times, gathering the results. - let replicateM mFunc n = - sequence (Seq.init n (fun _ -> mFunc)) + let replicateM mFunc n = sequence (Seq.init n (const' mFunc)) /// As replicateM but ignores the results - let repeatM mFunc n = - replicateM mFunc n >>= (return' << ignore) + let repeatM mFunc n = replicateM mFunc n >>= (return' << ignore) /// IOBuilder extensions so that iterM can be used to define For type IOBuilder with @@ -192,30 +219,45 @@ module IO = module Loops = /// Take elements repeatedly while a condition is met let takeWhileM p xs = - fromEffectful (fun _ -> - xs - |> Seq.takeWhile p - |> Seq.map (run) - |> List.ofSeq - |> Seq.ofList) + let rec takeWhileMRec p xs = + io { + match xs with + |[] -> return [] + |x::xs -> + let! q = p x + match q with + |true -> return! (takeWhileMRec p xs) >>= (fun xs' -> return' (x::xs')) + |false -> return [] + } + takeWhileMRec p xs /// Drop elements repeatedly while a condition is met let skipWhileM p xs = - fromEffectful (fun _ -> - xs - |> Seq.skipWhile p - |> Seq.map (run) - |> List.ofSeq - |> Seq.ofList) + let rec skipWhileMRec p xs = + io { + match xs with + |[] -> return [] + |x::xs -> + let! q = p x + match q with + |true -> return! skipWhileMRec p xs + |false -> return x::xs + } + skipWhileMRec p xs /// Execute an action repeatedly as long as the given boolean IO action returns true let whileM (pAct : IO) (f : IO<'a>) = - fromEffectful (fun _ -> - Seq.initInfinite (fun _ -> f) - |> Seq.map (run) - |> Seq.takeWhile (fun _ -> run pAct) - |> List.ofSeq - |> Seq.ofList) + let rec whileMRec() = + io { + let! p = pAct + match p with + |true -> + let! x = f + let! xs = whileMRec() + return x::xs + |false -> return [] + } + whileMRec() /// Execute an action repeatedly until the given boolean IO action returns true let untilM (pAct : IO) (f : IO<'a>) = whileM (not pAct) f @@ -223,12 +265,17 @@ module IO = /// As long as the supplied "Maybe" expression returns "Some _", each element will be bound using the value contained in the 'Some'. /// Results are collected into a sequence. let whileSome act binder = - fromEffectful (fun _ -> - Seq.initInfinite (fun _ -> run act) - |> Seq.takeWhile (Option.isSome) - |> Seq.map (run << binder << Option.get) - |> List.ofSeq - |> Seq.ofList) + let rec whileSomeRec() = + io { + let! p = act + match p with + |Some x -> + let! x' = binder x + let! xs = whileSomeRec() + return x'::xs + |None -> return [] + } + whileSomeRec() /// Yields the result of applying f until p holds. let rec iterateUntilM p f v = @@ -245,12 +292,19 @@ module IO = /// Repeatedly evaluates the second argument while the value satisfies the given predicate, and returns a list of all /// values that satisfied the predicate. Discards the final one (which failed the predicate). let unfoldWhileM p (f : IO<'a>) = - fromEffectful (fun _ -> - Seq.initInfinite (fun _ -> f) - |> Seq.map (run) - |> Seq.takeWhile p - |> List.ofSeq - |> Seq.ofList) + let rec unfoldWhileMRec() = + io { + let! x = f + match p x with + |true -> + let! xs = unfoldWhileMRec() + return x::xs + |false -> return [] + } + unfoldWhileMRec() + + /// Does the action f forever + let forever f = iterateWhile (const' true) f // ------ Parallel ------ // @@ -264,44 +318,23 @@ module IO = /// Executes the given IO actions in parallel let par (ios : IO<'a> list) = - fromEffectful (fun _ -> - ios + let allIOTasks = + ios |> Array.ofList - |> Array.Parallel.map (run) - |> List.ofArray) + |> Array.map (forkTask) + |> sequence + |> map (System.Threading.Tasks.Task.WhenAll) + map (List.ofArray) (allIOTasks >>= awaitTask) /// Executes the given IO actions in parallel and ignores the result let par_ (ios : IO<_> list) = map (ignore) (par ios) - - /// Executes the list of computations in parallel, returning the result of the first thread that completes with Some x, if any. - let parFirst (ios : IO<'a option> list) = - let raiseExn (e : #exn) = Async.FromContinuations(fun (_,econt,_) -> econt e) - let wrap task = - async { - let! res = task - match res with - | None -> return None - | Some r -> return! raiseExn <| SuccessException r - } - fromEffectful (fun _ -> - try - ios - |> Seq.map (fun io -> wrap <| async {return run io}) - |> Async.Parallel - |> Async.Ignore - |> Async.RunSynchronously - None - with - | :? SuccessException<'b> as ex -> Some <| ex.Value) /// mapConcurrently is similar to mapM but where each of the IO actions in the sequence are performed in parallel - let mapConcurrently f seq = - fromEffectful (fun _ -> - seq - |> Array.ofSeq - |> Array.Parallel.map (run << (flip bind) f) - |> Seq.ofArray) + let mapConcurrently (f : 'a -> IO<'b>) sequ = + List.map f sequ + |> List.ofSeq + |> par /// Module to provide the definition of the io computation expression [] diff --git a/src/NovelIO/MemoryBuffer.fs b/src/NovelIO/MemoryBuffer.fs index 6eb77fd..124f7d1 100644 --- a/src/NovelIO/MemoryBuffer.fs +++ b/src/NovelIO/MemoryBuffer.fs @@ -31,14 +31,16 @@ module MemoryBuffer = /// Create a channel from a memory buffer let bufferToTextChannel buffer = - IO.return' + IO.fromEffectful (fun _ -> {TextReader = new StreamReader(buffer.MemStream) |> Some; - TextWriter = new StreamWriter(buffer.MemStream) |> Some} + TextWriter = new StreamWriter(buffer.MemStream) |> Some; + IOMode = Synchronous}) /// Create a binary channel from a memory buffer let bufferToBinaryChannel buffer = - IO.return' - {BinaryReader = new BinaryReader(buffer.MemStream) |> Some; - BinaryWriter = new BinaryWriter(buffer.MemStream) |> Some} + IO.fromEffectful (fun _ -> + {IOStream = buffer.MemStream; + IOMode = Synchronous; + EOS = false}) diff --git a/src/NovelIO/PicklerInfrastructure.fs b/src/NovelIO/PicklerInfrastructure.fs index 2a9889f..5a1727d 100644 --- a/src/NovelIO/PicklerInfrastructure.fs +++ b/src/NovelIO/PicklerInfrastructure.fs @@ -23,8 +23,8 @@ exception PicklingExceededArrayLengthException of int * int type private BinaryUnpicklerState = {Raw : byte array; Position : int; Endianness : Endianness} type private BinaryPicklerState = {Raw : byte list; Endianness : Endianness} -type private IncrBinaryUnpicklerState = {Reader : System.IO.BinaryReader} -type private IncrBinaryPicklerState = {Writer : System.IO.BinaryWriter} +type private IncrBinaryUnpicklerState = {Reader : BChannel} +type private IncrBinaryPicklerState = {Writer : BChannel} type private BUnpickleState = |UnpickleComplete of BinaryUnpicklerState diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index 4f8e589..d2a3d66 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -130,11 +130,26 @@ type FileAccess = /// Read and write access to a file |ReadWrite +type ChannelIOMode = + |Synchronous + |Optimise + |Asynchronous + /// A channel that may support text being read from it and written to it -type TChannel = private {TextReader : StreamReader option; TextWriter : StreamWriter option} +type TChannel = + private { + TextReader : StreamReader option; + TextWriter : StreamWriter option; + IOMode : ChannelIOMode + } /// A channel that may support binary data being read from it or written to it -type BChannel = private {BinaryReader : BinaryReader option; BinaryWriter : BinaryWriter option} +type BChannel = + private { + IOStream : System.IO.Stream; + IOMode : ChannelIOMode; + mutable EOS : bool + } /// A TCP Server type TCPServer = private {TCPListener : Sockets.TcpListener} diff --git a/src/NovelIO/TCP.fs b/src/NovelIO/TCP.fs index a5eb820..fac3136 100644 --- a/src/NovelIO/TCP.fs +++ b/src/NovelIO/TCP.fs @@ -24,23 +24,28 @@ module Network = /// Type abbreviation for System.Net.IPAddress type IPAddress = System.Net.IPAddress - - - /// Provides functions relating to TCP connections module TCP = module private SideEffecting = /// Accept a socket from a TCP Server let acceptSocketFromServer serv = - {TCPConnectedSocket = serv.TCPListener.AcceptSocket()} + async { + let! sock = Async.AwaitTask <| serv.TCPListener.AcceptSocketAsync() + return {TCPConnectedSocket = sock} + } + /// Connect a TCP Socket to a specified ip and port let connectTCPSocket (ip : IPAddress) (port : int) = let sock = new Sockets.Socket(Sockets.SocketType.Stream, Sockets.ProtocolType.Tcp) sock.Connect(ip, port) {TCPConnectedSocket = sock} + /// Close a socket - let closeSocket sock = - sock.TCPConnectedSocket.Disconnect false + let closeSocket sock = sock.TCPConnectedSocket.Disconnect(false) + + /// Retrieves the port the server is listening on + let getServerPort server = (server.TCPListener.Server.LocalEndPoint :?> System.Net.IPEndPoint).Port + /// Start a TCP server on a supplied ip address and port let startTCPServer ip port = let listener = Sockets.TcpListener(ip, port) @@ -48,7 +53,7 @@ module TCP = {TCPListener = listener} /// Accept a connection from the supplied TCP server - let private acceptConn serv = IO.fromEffectful (fun () -> SideEffecting.acceptSocketFromServer serv) + let private acceptConn serv = IO.liftAsync <| SideEffecting.acceptSocketFromServer serv /// Create a TCP server at the specfied IP on the specified port let createServer ip port = IO.fromEffectful (fun () -> SideEffecting.startTCPServer ip port) @@ -69,15 +74,19 @@ module TCP = let connectSocket ip port = IO.fromEffectful (fun () -> SideEffecting.connectTCPSocket ip port) /// Retrieves the port the server is listening on - let getServerPort server = - IO.fromEffectful (fun () -> - let ipend = server.TCPListener.Server.LocalEndPoint :?> System.Net.IPEndPoint - ipend.Port) + let getServerPort server = IO.fromEffectful (fun () -> SideEffecting.getServerPort server) - /// Create a channel from a connected socket + /// Create a text channel from a connected socket let socketToTextChannel tcpSocket = - IO.return' + IO.fromEffectful (fun _ -> {TextReader = new StreamReader(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some; - TextWriter = new StreamWriter(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some} + TextWriter = new StreamWriter(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some; + IOMode = Asynchronous}) + + /// Create a binary channel from a connect socket + let socketToBinaryChannel tcpSocket = + IO.fromEffectful (fun _ -> + let nStream = new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket) + {IOStream = nStream; IOMode = Asynchronous; EOS = false}) diff --git a/tests/NovelIO.IntegrationTests/FileTests.fs b/tests/NovelIO.IntegrationTests/FileTests.fs index aa24983..0a6239d 100644 --- a/tests/NovelIO.IntegrationTests/FileTests.fs +++ b/tests/NovelIO.IntegrationTests/FileTests.fs @@ -30,23 +30,6 @@ type ``File Integration Tests``() = let fname = File.assumeValidFilename fnameStr IO.run <| File.readAllBytes fname = bytes - [] - static member ``Read lines from file`` (strA : NonEmptyArray) = - let fnameStr = "readlinestest.tst" - let lstStrs = - strA.Get - |> Array.collect (fun str -> str.Get.Split('\r','\n')) - |> List.ofArray - System.IO.File.WriteAllLines(fnameStr, lstStrs) - let fname = File.assumeValidFilename fnameStr - let lineIO = - io { - let! lineSeq = File.readLines fname - let! uwSeq = IO.sequence lineSeq - return List.ofSeq uwSeq - } - IO.run lineIO = lstStrs - [] static member ``Read all lines from file`` (strA : NonEmptyArray) = let fnameStr = "readlinestest.tst" From 785ad358230de9abf8aab5cb538169f5f607c17c Mon Sep 17 00:00:00 2001 From: Phil Date: Mon, 29 Aug 2016 16:43:44 +0100 Subject: [PATCH 04/20] Added tests of takeWhileM, skipWhileM, whileM, untilM and whileSome --- tests/NovelIO.UnitTests/LoopsTests.fs | 75 +++++++++++++++++++ .../NovelIO.UnitTests.fsproj | 1 + 2 files changed, 76 insertions(+) create mode 100644 tests/NovelIO.UnitTests/LoopsTests.fs diff --git a/tests/NovelIO.UnitTests/LoopsTests.fs b/tests/NovelIO.UnitTests/LoopsTests.fs new file mode 100644 index 0000000..7bc36c0 --- /dev/null +++ b/tests/NovelIO.UnitTests/LoopsTests.fs @@ -0,0 +1,75 @@ +(* + Copyright 2015-2016 Philip Curzon + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +namespace NovelFS.NovelIO.UnitTests + +open NovelFS.NovelIO +open NovelFS.NovelIO.IO.Operators +open FsCheck +open FsCheck.Xunit + +type ``IO Loops Tests``() = + [] + static member ``takeWhileM returns same results as takeWhile for pure operation`` (lst : int list, barrier : int) = + IO.Loops.takeWhileM (fun x -> IO.return'(x > barrier) ) lst + |> IO.run = List.takeWhile (fun x -> x > barrier) lst + + [] + static member ``skipWhileM returns same results as skipWhile for pure operation`` (lst : int list, barrier : int) = + IO.Loops.skipWhileM (fun x -> IO.return'(x > barrier) ) lst + |> IO.run = List.skipWhile (fun x -> x > barrier) lst + + [] + static member ``whileM with mutable counter that counts up to 'count' and returns zero creates zeros of length 'count'`` (count : PositiveInt) = + let count = count.Get + let bCount = ref 0 + let execCount = ref 0 + let continueWhile = IO.fromEffectful (fun _ -> + if !bCount < count then + incr bCount + true + else false) + let zeroIO = IO.fromEffectful (fun _ -> 0) + let res = IO.Loops.whileM continueWhile zeroIO |> IO.run + !bCount = count && res = List.init count (const' 0) + + [] + static member ``untilM with mutable counter that counts up to 'count' and returns zero creates zeros of length 'count'`` (count : PositiveInt) = + let count = count.Get + let bCount = ref 0 + let execCount = ref 0 + let continueUntil = IO.fromEffectful (fun _ -> + if !bCount < count then + incr bCount + false + else true) + let zeroIO = IO.fromEffectful (fun _ -> 0) + let res = IO.Loops.untilM continueUntil zeroIO |> IO.run + !bCount = count && res = List.init count (const' 0) + + [] + static member ``whileSome with mutable counter that counts up to 'count' and returns Some i creates list of 1..count'`` (count : PositiveInt) = + let count = count.Get + let bCount = ref 0 + let execCount = ref 0 + let optIO = IO.fromEffectful (fun _ -> + if !bCount < count then + incr bCount + Some !bCount + else None) + let res = IO.Loops.whileSome optIO (IO.return') |> IO.run + !bCount = count && res = List.init count ((+) 1) + \ No newline at end of file diff --git a/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj b/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj index 8cf9a76..c241493 100644 --- a/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj +++ b/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj @@ -59,6 +59,7 @@ + PreserveNewest From 7ff83a440e20a16ec348331890b9c00f9378fe28 Mon Sep 17 00:00:00 2001 From: Phil Date: Tue, 30 Aug 2016 01:15:58 +0100 Subject: [PATCH 05/20] Changed some of the monadic loop implementations to be tail recursive --- src/NovelIO/IO.fs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 4aaae2f..970076c 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -33,8 +33,8 @@ module IO = let rec private runIO io = match io with |Return a -> a - |SyncIO (f) -> runIO <| f() - |AsyncIO a -> runIO << Async.RunSynchronously <| a + |SyncIO (f) -> runIO (f()) + |AsyncIO a -> runIO (Async.RunSynchronously a) let rec private runAsyncIO io = match io with @@ -247,17 +247,16 @@ module IO = /// Execute an action repeatedly as long as the given boolean IO action returns true let whileM (pAct : IO) (f : IO<'a>) = - let rec whileMRec() = + let rec whileMRec acc = io { let! p = pAct match p with |true -> let! x = f - let! xs = whileMRec() - return x::xs - |false -> return [] + return! whileMRec (x::acc) + |false -> return acc } - whileMRec() + whileMRec [] /// Execute an action repeatedly until the given boolean IO action returns true let untilM (pAct : IO) (f : IO<'a>) = whileM (not pAct) f @@ -265,17 +264,16 @@ module IO = /// As long as the supplied "Maybe" expression returns "Some _", each element will be bound using the value contained in the 'Some'. /// Results are collected into a sequence. let whileSome act binder = - let rec whileSomeRec() = + let rec whileSomeRec acc = io { let! p = act match p with |Some x -> let! x' = binder x - let! xs = whileSomeRec() - return x'::xs - |None -> return [] + return! whileSomeRec (x' :: acc) + |None -> return acc } - whileSomeRec() + whileSomeRec [] /// Yields the result of applying f until p holds. let rec iterateUntilM p f v = From 3f67b2013d5f5827bda73c320d55d026429dde4d Mon Sep 17 00:00:00 2001 From: Phil Date: Tue, 30 Aug 2016 01:41:37 +0100 Subject: [PATCH 06/20] unfoldWhileM is now also tail recursive write/writeLine streamwriter functions changed to explicit implementations. --- src/NovelIO/Channels.fs | 14 +++++++++----- src/NovelIO/IO.fs | 10 ++++------ 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/NovelIO/Channels.fs b/src/NovelIO/Channels.fs index 15d6ecb..1f0fdab 100644 --- a/src/NovelIO/Channels.fs +++ b/src/NovelIO/Channels.fs @@ -47,11 +47,15 @@ module TextChannel = |Some txtRdr -> async { return! Async.AwaitTask <| txtRdr.ReadLineAsync()} |None -> raise ChannelDoesNotSupportReadingException /// Writes a string to a text channel - let putStr (str : string) channel = - putStrF (fun txtWrtr -> txtWrtr.Write str) channel + let write (str : string) channel = + match channel.TextWriter with + |Some txtWrtr -> txtWrtr.Write(str) + |None -> raise ChannelDoesNotSupportWritingException /// Writes a string line to a text channel - let putStrLn (str : string) channel = - putStrF (fun txtWrtr -> txtWrtr.WriteLine str) channel + let writeLine (str : string) channel = + match channel.TextWriter with + |Some txtWrtr -> txtWrtr.WriteLine(str) + |None -> raise ChannelDoesNotSupportWritingException /// Determines whether a supplied text channel is ready to be read from let isChannelReadyToRead channel = match channel.TextReader with @@ -82,7 +86,7 @@ module TextChannel = let isReady channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelReadyToRead channel) /// An action that writes a line to the text channel - let putStrLn channel str = IO.fromEffectful (fun _ -> SideEffecting.putStrLn str channel) + let putStrLn channel str = IO.fromEffectful (fun _ -> SideEffecting.writeLine str channel) /// Operations on binary channels module BinaryChannel = diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 970076c..4878d67 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -290,16 +290,14 @@ module IO = /// Repeatedly evaluates the second argument while the value satisfies the given predicate, and returns a list of all /// values that satisfied the predicate. Discards the final one (which failed the predicate). let unfoldWhileM p (f : IO<'a>) = - let rec unfoldWhileMRec() = + let rec unfoldWhileMRec acc = io { let! x = f match p x with - |true -> - let! xs = unfoldWhileMRec() - return x::xs - |false -> return [] + |true -> return! unfoldWhileMRec (x::acc) + |false -> return acc } - unfoldWhileMRec() + unfoldWhileMRec [] /// Does the action f forever let forever f = iterateWhile (const' true) f From bbd87508e68c1d94346bf64c043af87210a58e30 Mon Sep 17 00:00:00 2001 From: Phil Date: Wed, 31 Aug 2016 02:04:45 +0100 Subject: [PATCH 07/20] Improved awaiting of async io nested within sync io Fixed backwards lists in monad loops Added iter prefixed monadic loops which return unit --- src/NovelIO/IO.fs | 39 ++++++++++++++++++++++++++++++++------ src/NovelIO/NovelIO.fsproj | 2 +- 2 files changed, 34 insertions(+), 7 deletions(-) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 4878d67..b1ba2b6 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -30,11 +30,11 @@ type IO<'a> = module IO = // ------- RUN ------- // - let rec private runIO io = + let rec private runUntilAsync io = match io with - |Return a -> a - |SyncIO (f) -> runIO (f()) - |AsyncIO a -> runIO (Async.RunSynchronously a) + |Return a -> async.Return <| Return a + |SyncIO f -> runUntilAsync (f()) + |AsyncIO a -> a let rec private runAsyncIO io = match io with @@ -42,8 +42,16 @@ module IO = |SyncIO f -> runAsyncIO <| f() |AsyncIO a -> async.Bind (a, runAsyncIO) + let rec private runRec (io : IO<'a>) : Async<'a> = + async{ + let! io' = runUntilAsync io + match io' with + |Return res -> return res + |_ -> return! runRec io' + } + /// Runs the IO actions and evaluates the result - let run io = runIO io + let run io = runRec io |> Async.RunSynchronously // ------- MONAD ------- // @@ -256,11 +264,28 @@ module IO = return! whileMRec (x::acc) |false -> return acc } - whileMRec [] + whileMRec [] + |> map (List.rev) + + /// Execute an action repeatedly as long as the given boolean IO action returns true + let iterWhileM (pAct : IO) (f : IO<'a>) = + let rec whileMRec() = + io { + let! p = pAct + match p with + |true -> + let! x = f + return! whileMRec() + |false -> return () + } + whileMRec () /// Execute an action repeatedly until the given boolean IO action returns true let untilM (pAct : IO) (f : IO<'a>) = whileM (not pAct) f + /// Execute an action repeatedly until the given boolean IO action returns true + let iterUntilM (pAct : IO) (f : IO<'a>) = iterWhileM (not pAct) f + /// As long as the supplied "Maybe" expression returns "Some _", each element will be bound using the value contained in the 'Some'. /// Results are collected into a sequence. let whileSome act binder = @@ -274,6 +299,7 @@ module IO = |None -> return acc } whileSomeRec [] + |> map (List.rev) /// Yields the result of applying f until p holds. let rec iterateUntilM p f v = @@ -298,6 +324,7 @@ module IO = |false -> return acc } unfoldWhileMRec [] + |> map (List.rev) /// Does the action f forever let forever f = iterateWhile (const' true) f diff --git a/src/NovelIO/NovelIO.fsproj b/src/NovelIO/NovelIO.fsproj index 337c312..1cffb84 100644 --- a/src/NovelIO/NovelIO.fsproj +++ b/src/NovelIO/NovelIO.fsproj @@ -18,7 +18,7 @@ true full false - false + true bin\Debug\ DEBUG;TRACE 3 From 9814a1e5e59f83f2fa2f73c095e18cea91fcc85c Mon Sep 17 00:00:00 2001 From: Phil Date: Thu, 1 Sep 2016 00:04:35 +0100 Subject: [PATCH 08/20] Changed mapM, chooseM, filterM, foldM and replicateM to be list based iterM is replaced by a new, tail recursive, implementation Added tests for iterM and for in IO computation expression --- src/NovelIO/IO.fs | 46 ++++++++++++++++----------- tests/NovelIO.UnitTests/IOTests.fs | 32 ++++++++++++++++++- tests/NovelIO.UnitTests/LoopsTests.fs | 28 ++++++++++++++++ 3 files changed, 87 insertions(+), 19 deletions(-) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index b1ba2b6..a277ce7 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -150,9 +150,9 @@ module IO = let bracket act fClnUp fBind = io { let! a = act - return! fromEffectful (fun _ -> + return! SyncIO (fun _ -> try - run <| fBind a + fBind a finally ignore << run <| fClnUp a) } @@ -180,37 +180,43 @@ module IO = /// Map each element of a list to a monadic action, evaluate these actions from left to right and collect the results as a sequence. let mapM mFunc sequ = let consF x ys = lift2 (listCons) (mFunc x) ys - Seq.foldBack (consF) sequ (return' []) - |> map (Seq.ofList) + List.foldBack (consF) sequ (return' []) /// Map each element of a list to a monadic action of options, evaluate these actions from left to right and collect the results which are 'Some' as a sequence. let chooseM mFunc sequ = let consF = function |Some v -> listCons (v) |None -> id - Seq.foldBack (fun x -> lift2 consF (mFunc x)) sequ (return' []) - |> map (Seq.ofList) + List.foldBack (lift2 consF << mFunc) sequ (return' []) /// Filters a sequence based upon a monadic predicate, collecting the results as a sequence let filterM pred sequ = - Seq.foldBack (fun x -> lift2 (fun flg -> if flg then (listCons x) else id) (pred x)) sequ (return' []) - |> map (Seq.ofList) + List.foldBack (fun x -> lift2 (fun flg -> if flg then (listCons x) else id) (pred x)) sequ (return' []) - /// As mapM but ignores the result. - let iterM mFunc sequ = - mapM (mFunc) sequ - |> map (ignore) + /// Map each element of a list to a monadic action, evaluate these actions from left to right and ignore the results. + let iterM (mFunc : 'a -> IO<'b>) (sequ : seq<'a>) = + SyncIO (fun _ -> + use enmr = sequ.GetEnumerator() + let rec iterMRec() = + io { + match enmr.MoveNext() with + |true -> + let! res = mFunc (enmr.Current) + return! iterMRec() + |false -> return () + } + iterMRec()) /// Analogous to fold, except that the results are encapsulated within IO let foldM accFunc acc sequ = let f' x k z = accFunc z x >>= k - Seq.foldBack (f') sequ return' acc + List.foldBack (f') sequ return' acc /// Evaluate each action in the sequence from left to right and collect the results as a sequence. let sequence seq = mapM id seq /// Performs the action mFunc n times, gathering the results. - let replicateM mFunc n = sequence (Seq.init n (const' mFunc)) + let replicateM mFunc n = sequence (List.init n (const' mFunc)) /// As replicateM but ignores the results let repeatM mFunc n = replicateM mFunc n >>= (return' << ignore) @@ -303,9 +309,13 @@ module IO = /// Yields the result of applying f until p holds. let rec iterateUntilM p f v = - match p v with - |true -> return' v - |false -> f v >>= iterateUntilM p f + io { + match p v with + |true -> return v + |false -> + let! v' = f v + return! iterateUntilM p f v' + } /// Execute an action repeatedly until its result satisfies a predicate and return that result (discarding all others). let iterateUntil p x = x >>= iterateUntilM p (const' x) @@ -345,6 +355,7 @@ module IO = ios |> Array.ofList |> Array.map (forkTask) + |> List.ofArray |> sequence |> map (System.Threading.Tasks.Task.WhenAll) map (List.ofArray) (allIOTasks >>= awaitTask) @@ -356,7 +367,6 @@ module IO = /// mapConcurrently is similar to mapM but where each of the IO actions in the sequence are performed in parallel let mapConcurrently (f : 'a -> IO<'b>) sequ = List.map f sequ - |> List.ofSeq |> par /// Module to provide the definition of the io computation expression diff --git a/tests/NovelIO.UnitTests/IOTests.fs b/tests/NovelIO.UnitTests/IOTests.fs index 580b15d..44b5f65 100644 --- a/tests/NovelIO.UnitTests/IOTests.fs +++ b/tests/NovelIO.UnitTests/IOTests.fs @@ -89,4 +89,34 @@ type ``IO Unit Tests``() = let closed = IO.fromEffectful (fun _ -> called <- true) let nothing = IO.fromEffectful (fun _ -> ()) IO.bracket create (fun _ -> closed) (fun _ -> nothing) |> IO.run - called = true \ No newline at end of file + called = true + + [] + static member ``bracket calls inner action`` () = + let create = IO.return' () + let mutable called = false + let closed = IO.fromEffectful (fun _ -> ()) + let act = IO.fromEffectful (fun _ -> called <- true) + IO.bracket create (fun _ -> closed) (fun _ -> act) |> IO.run + called = true + + [] + static member ``iterM over sequence of 0..1e6 value and incr action produces 1e6 value`` () = + let mutable x = ref 0 + let action = IO.fromEffectful (fun _ -> incr x) + let ios = Seq.init (1000000) id + let iterm = IO.iterM (const' action) ios + IO.run iterm + !x = 1000000 + + [] + static member ``for over sequence of 0..1e6 value and incr action produces 1e6 value`` () = + let mutable x = ref 0 + let action = IO.fromEffectful (fun _ -> incr x) + io { + for x in [1..1000000] do + do! action + } |> IO.run + !x = 1000000 + + diff --git a/tests/NovelIO.UnitTests/LoopsTests.fs b/tests/NovelIO.UnitTests/LoopsTests.fs index 7bc36c0..b0a0e5b 100644 --- a/tests/NovelIO.UnitTests/LoopsTests.fs +++ b/tests/NovelIO.UnitTests/LoopsTests.fs @@ -46,6 +46,20 @@ type ``IO Loops Tests``() = let res = IO.Loops.whileM continueWhile zeroIO |> IO.run !bCount = count && res = List.init count (const' 0) + [] + static member ``iterWhileM with mutable counters that count up to 'count' both equal count`` (count : PositiveInt) = + let count = count.Get + let bCount = ref 0 + let execCount = ref 0 + let continueUntil = IO.fromEffectful (fun _ -> + if !bCount < count then + incr bCount + true + else false) + let incrIO = IO.fromEffectful (fun _ -> incr execCount) + let res = IO.Loops.iterWhileM continueUntil incrIO |> IO.run + !bCount = count && !execCount = count + [] static member ``untilM with mutable counter that counts up to 'count' and returns zero creates zeros of length 'count'`` (count : PositiveInt) = let count = count.Get @@ -60,6 +74,20 @@ type ``IO Loops Tests``() = let res = IO.Loops.untilM continueUntil zeroIO |> IO.run !bCount = count && res = List.init count (const' 0) + [] + static member ``iterUntilM with mutable counters that count up to 'count' both equal count`` (count : PositiveInt) = + let count = count.Get + let bCount = ref 0 + let execCount = ref 0 + let continueUntil = IO.fromEffectful (fun _ -> + if !bCount < count then + incr bCount + false + else true) + let incrIO = IO.fromEffectful (fun _ -> incr execCount) + let res = IO.Loops.iterUntilM continueUntil incrIO |> IO.run + !bCount = count && !execCount = count + [] static member ``whileSome with mutable counter that counts up to 'count' and returns Some i creates list of 1..count'`` (count : PositiveInt) = let count = count.Get From 89334c527eaffd85c109a7c2fdc9aae7b7bbeef7 Mon Sep 17 00:00:00 2001 From: Phil Date: Thu, 1 Sep 2016 19:21:21 +0100 Subject: [PATCH 09/20] Made ChannelIOMode require qualified access Renamed mapM to traverse Started work on revising documentation --- docs/content/index.fsx | 83 ++++++++++++++++---- src/NovelIO/Channels.fs | 14 +++- src/NovelIO/File.fs | 4 +- src/NovelIO/IO.fs | 17 ++-- src/NovelIO/MemoryBuffer.fs | 4 +- src/NovelIO/Prelude.fs | 5 ++ src/NovelIO/Scripts/load-project-release.fsx | 3 + src/NovelIO/Scripts/load-project.fsx | 11 +++ src/NovelIO/TCP.fs | 4 +- tests/NovelIO.UnitTests/IOTests.fs | 8 +- 10 files changed, 113 insertions(+), 40 deletions(-) diff --git a/docs/content/index.fsx b/docs/content/index.fsx index 5c10294..d857816 100644 --- a/docs/content/index.fsx +++ b/docs/content/index.fsx @@ -16,16 +16,20 @@ Much like in Haskell, we introduce the `IO<'a>` type which represents some actio * An IO action that prints the string "Hello World" to the screen has type `IO`. * An IO action that gets a line of text from the Console has type `IO`. * An IO action that opens a TCP connection has type `IO`. +* An IO action that launches some missiles has type `IO` -The IO action can equally represent a sequence of actions: +The IO action can equally represent an arbitrary sequence of actions: * An IO action that requests a Name, then that person's Date of Birth from a service might have type `IO` +* An IO action that returns a potentially unknown number of lines from a file might have type `IO` + +Indeed an entire web server could be represented as a single value of type `IO`. Values of type `IO<'a>` are distinct from traditional values in that they do not represent the result of some side effect, they rather represent an action (or sequence of actions) that can be `run` to produce a particular result. ## Running IO Actions -`IO<'a>` Actions can be `run` using the `IO.run` function. This results in all of the side-effects being evaluated, resulting in something of type `'a`. +`IO<'a>` Actions can be `run` using the `IO.run` function. This results in all of the side-effects being evaluated and the generation of a result of type `'a`. These values can then be re-used and run again to evaluate the side-effects once more. @@ -49,7 +53,7 @@ printfn "%s" (IO.run exmpl2) (** -If we run these examples, we can note the different behaviour. +Take careful note of the different behaviour. In the first example `exmpl` represents the result of the user input from the console, we perform that side effect only once and print the same value to the console twice. @@ -59,23 +63,69 @@ In the second example `exmpl2` represents the action of reading user input from It is possible (albeit certainly not recommended!) to call `IO.run` on every small block of IO code. It is also possible to call `IO.run` only once, in the main function, for an entire program: it is then possible to visualise the running of a program as the only effectful part of otherwise pure, referentially transparent code. -## Sequencing IO Actions +## Compositionality + +One of the key attractions of this representation of IO is that we can design IO actions and then compose them together to build new and more complex IO actions. -It is possible to sequence I/O operations using the `io` computation expression (very similar to the do notation found in Haskell). +Let's assume for a moment that we wish to read two lines from the console and return them as a tuple. That can be achieved as follows: *) -io { - let! l1 = Console.readLine - let! l2 = Console.readLine - let! l3 = Console.readLine - do! IO.putStrLn <| sprintf "You entered: %A" [l1; l2; l3] -} |> IO.run +let readTwoLines = + io { + let! line1 = Console.readLine + let! line2 = Console.readLine + return line1, line2 + } + +(** + +`let!` is used to request the result of an IO action when the enclosing action is run. + +Notice that we have taken two primitive IO actions of type `IO` and used them to construct a new IO action of type `IO` + +Likewise, if we wished to write two lines to the console, we could construct an action like this: + +*) + +let writeTwoLines line1 line2 = + io { + do! Console.writeLine line1 + do! Console.writeLine line2 + } + +(** + +`do!` is used to evaluate an IO action of type `unit` when the enclosing action is run. + +In this case, we have taken two IO actions of type `IO` and created a new action of type `IO`. + +## Loops + +A common task during I/O operations is to perform some action until a condition is met. There are a variety of combinators to help with this sort of task: + +Let's assume we wish to print the numbers 1..10 to the console. One way of doing this would be: + +*) + +let print1To10 = + IO.iterM (fun i -> Console.writeLine <| string i) [1..10] // The lambda here could be replaced by (Console.writeLine << string) + +(** + +The `iterM` function is used to define `for` loops in the IO monad. The below code is completely equivalent to the above: + +*) + +let print1To10For = + io { + for i in [1..10] do + do! Console.writeLine <| string i + } (** -Here we simply read three lines from the console and print the result back to the console as a list. -Needless to say, highly complex actions can be built up in this way. For example, running a webserver could be represented as a single `IO` action. +It is possible to sequence I/O operations using the `io` computation expression. ## Parallel IO @@ -98,14 +148,15 @@ This describes a program that gets a line from the console and a line from a spe It's very likely that the set of functions included in this library will not cover every possible IO action we might ever wish to perform. In this case, we can use the `IO.fromEffectful` to take a non-referentially transparent function and bring it within IO. -If we decide to create an action that exits the program, this could be accomplished as follows: +Here is an example of creating a simple IO action that increments a reference variable. *) -let exit = IO.fromEffectful (fun _ -> System.Environment.Exit 0) +let num = ref 0 +let incrIO = IO.fromEffectful (fun _ -> incr num) (** -This should allow us to construct arbitrary programs entirely within IO. +This allows us to construct arbitrary programs entirely within IO. *) \ No newline at end of file diff --git a/src/NovelIO/Channels.fs b/src/NovelIO/Channels.fs index 1f0fdab..ecbea23 100644 --- a/src/NovelIO/Channels.fs +++ b/src/NovelIO/Channels.fs @@ -56,6 +56,11 @@ module TextChannel = match channel.TextWriter with |Some txtWrtr -> txtWrtr.WriteLine(str) |None -> raise ChannelDoesNotSupportWritingException + /// Writes a string line to a text channel asynchronously + let writeLineAsync (str : string) channel = + match channel.TextWriter with + |Some txtWrtr -> txtWrtr.WriteLineAsync(str) |> Async.AwaitTask + |None -> raise ChannelDoesNotSupportWritingException /// Determines whether a supplied text channel is ready to be read from let isChannelReadyToRead channel = match channel.TextReader with @@ -73,7 +78,7 @@ module TextChannel = /// An action that reads a line from the text channel let getLine (channel : TChannel) = match channel.IOMode with - |Synchronous -> IO.fromEffectful (fun _ -> SideEffecting.getLine channel) + |ChannelIOMode.Synchronous -> IO.fromEffectful (fun _ -> SideEffecting.getLine channel) |_ -> IO.liftAsync <| SideEffecting.getLineAsync channel /// An action that determines if the text channel is at the end of the stream. This a synonym for isEOF @@ -86,7 +91,10 @@ module TextChannel = let isReady channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelReadyToRead channel) /// An action that writes a line to the text channel - let putStrLn channel str = IO.fromEffectful (fun _ -> SideEffecting.writeLine str channel) + let putStrLn (channel : TChannel) str = + match channel.IOMode with + |ChannelIOMode.Synchronous -> IO.fromEffectful (fun _ -> SideEffecting.writeLine str channel) + |_ -> IO.liftAsync <| SideEffecting.writeLineAsync str channel /// Operations on binary channels module BinaryChannel = @@ -151,7 +159,7 @@ module BinaryChannel = /// Higher order function for performing channel actions synchrously or asynchronously let private syncOrAsync syncFunc asyncA count channel = match channel.IOMode with - |Synchronous | Optimise when count < 1024 -> IO.fromEffectful syncFunc + |ChannelIOMode.Synchronous | ChannelIOMode.Optimise when count < 1024 -> IO.fromEffectful syncFunc |_ -> IO.liftAsync asyncA /// Provides a general approach for reading partial byte arrays from a channel diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index bc6678c..6a35629 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -41,12 +41,12 @@ module private SideEffectingFileIO = |NovelFS.NovelIO.FileAccess.Read -> Some <| crTxtRdr fStream, None |NovelFS.NovelIO.FileAccess.ReadWrite -> Some <| crTxtRdr fStream, Some <| crTxtWrtr fStream |NovelFS.NovelIO.FileAccess.Write -> None, Some <| crTxtWrtr fStream - {TextReader = reader; TextWriter = writer; IOMode = Optimise} + {TextReader = reader; TextWriter = writer; IOMode = ChannelIOMode.Synchronous} /// Create a binary file channel for a supplied file name, file mode and file access let openBinaryFileChannel (fName : FilePath) mode access = let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) - {IOStream = fStream; IOMode = Optimise; EOS = false} + {IOStream = fStream; IOMode = ChannelIOMode.Optimise; EOS = false} /// Provides functions relating to the creating, copying, deleting, moving, opening and reading of files module File = diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index a277ce7..902333a 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -150,9 +150,9 @@ module IO = let bracket act fClnUp fBind = io { let! a = act - return! SyncIO (fun _ -> + return! fromEffectful (fun _ -> try - fBind a + run <| fBind a finally ignore << run <| fClnUp a) } @@ -178,9 +178,9 @@ module IO = let awaitTask task = liftAsync <| Async.AwaitTask task /// Map each element of a list to a monadic action, evaluate these actions from left to right and collect the results as a sequence. - let mapM mFunc sequ = + let traverse mFunc lst = let consF x ys = lift2 (listCons) (mFunc x) ys - List.foldBack (consF) sequ (return' []) + List.foldBack (consF) lst (return' []) /// Map each element of a list to a monadic action of options, evaluate these actions from left to right and collect the results which are 'Some' as a sequence. let chooseM mFunc sequ = @@ -212,8 +212,8 @@ module IO = let f' x k z = accFunc z x >>= k List.foldBack (f') sequ return' acc - /// Evaluate each action in the sequence from left to right and collect the results as a sequence. - let sequence seq = mapM id seq + /// Evaluate each action in the list from left to right and collect the results as a list. + let sequence seq = traverse id seq /// Performs the action mFunc n times, gathering the results. let replicateM mFunc n = sequence (List.init n (const' mFunc)) @@ -344,11 +344,6 @@ module IO = /// Parallel IO combinators module Parallel = - /// A helper type for ending computations when success occurs - type private SuccessException<'a> (value : 'a) = - inherit System.Exception() - member __.Value = value - /// Executes the given IO actions in parallel let par (ios : IO<'a> list) = let allIOTasks = diff --git a/src/NovelIO/MemoryBuffer.fs b/src/NovelIO/MemoryBuffer.fs index 124f7d1..a14027c 100644 --- a/src/NovelIO/MemoryBuffer.fs +++ b/src/NovelIO/MemoryBuffer.fs @@ -34,13 +34,13 @@ module MemoryBuffer = IO.fromEffectful (fun _ -> {TextReader = new StreamReader(buffer.MemStream) |> Some; TextWriter = new StreamWriter(buffer.MemStream) |> Some; - IOMode = Synchronous}) + IOMode = ChannelIOMode.Synchronous}) /// Create a binary channel from a memory buffer let bufferToBinaryChannel buffer = IO.fromEffectful (fun _ -> {IOStream = buffer.MemStream; - IOMode = Synchronous; + IOMode = ChannelIOMode.Synchronous; EOS = false}) diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index d2a3d66..cfba6c6 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -130,9 +130,14 @@ type FileAccess = /// Read and write access to a file |ReadWrite +/// Defines the IO mode of a channel +[] type ChannelIOMode = + /// Use sychronous (blocking) IO |Synchronous + /// Choose between sychronous or asynchronous IO depending on what is likely to perform best |Optimise + /// Use asychronous IO |Asynchronous /// A channel that may support text being read from it and written to it diff --git a/src/NovelIO/Scripts/load-project-release.fsx b/src/NovelIO/Scripts/load-project-release.fsx index df93523..c172f15 100644 --- a/src/NovelIO/Scripts/load-project-release.fsx +++ b/src/NovelIO/Scripts/load-project-release.fsx @@ -5,6 +5,9 @@ "../Helper.fs" "../Encoding.fs" "../IO.fs" + "../Actions.fs" + "../Channels.fs" + "../PicklerInfrastructure.fs" "../BinaryPickler.fs" "../File.fs" "../TCP.fs" diff --git a/src/NovelIO/Scripts/load-project.fsx b/src/NovelIO/Scripts/load-project.fsx index 3b69dd0..9f6a207 100644 --- a/src/NovelIO/Scripts/load-project.fsx +++ b/src/NovelIO/Scripts/load-project.fsx @@ -13,3 +13,14 @@ @"..\TCP.fs" @"..\Random.fs" @"..\MemoryBuffer.fs" + +open NovelFS.NovelIO +open NovelFS.NovelIO.IO.Operators + +let file = File.assumeValidFilename """D:\3DLM SM v3 analysis review 151207.pdf""" + +let file2 = File.assumeValidFilename """D:\test.pdf""";; + +File.withTextChannel (FileMode.Open) (FileAccess.Read) file (fun chan -> + File.withTextChannel (FileMode.Create) (FileAccess.Write) file2 (fun chan2 -> + IO.Loops.untilM (TextChannel.isEOF chan) (TextChannel.getLine chan >>= TextChannel.putStrLn chan2))) diff --git a/src/NovelIO/TCP.fs b/src/NovelIO/TCP.fs index fac3136..026392f 100644 --- a/src/NovelIO/TCP.fs +++ b/src/NovelIO/TCP.fs @@ -81,12 +81,12 @@ module TCP = IO.fromEffectful (fun _ -> {TextReader = new StreamReader(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some; TextWriter = new StreamWriter(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some; - IOMode = Asynchronous}) + IOMode = ChannelIOMode.Asynchronous}) /// Create a binary channel from a connect socket let socketToBinaryChannel tcpSocket = IO.fromEffectful (fun _ -> let nStream = new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket) - {IOStream = nStream; IOMode = Asynchronous; EOS = false}) + {IOStream = nStream; IOMode = ChannelIOMode.Asynchronous; EOS = false}) diff --git a/tests/NovelIO.UnitTests/IOTests.fs b/tests/NovelIO.UnitTests/IOTests.fs index 44b5f65..d40f9bf 100644 --- a/tests/NovelIO.UnitTests/IOTests.fs +++ b/tests/NovelIO.UnitTests/IOTests.fs @@ -33,8 +33,8 @@ type ``IO Unit Tests``() = IO.run <| IO.fromEffectful (fun _ -> testData) = testData [] - static member ``mapM matches results of map when run on pure binding function`` (testData : int list) = - let test = IO.mapM (IO.return' << ((+)1)) testData + static member ``traverse matches results of map when run on pure binding function`` (testData : int list) = + let test = IO.traverse (IO.return' << ((+)1)) testData let result = List.ofSeq <| IO.run test let mappedTestData = List.map ((+) 1) testData result = mappedTestData @@ -64,9 +64,9 @@ type ``IO Unit Tests``() = result = filteredTestData [] - static member ``mapM does not create side effects until run`` (testData : obj list) = + static member ``traverse does not create side effects until run`` (testData : obj list) = let createTestFail = IO.fromEffectful (fun _ -> failwith "Side effect created") - let test = IO.mapM (fun _ -> createTestFail) testData + let test = IO.traverse (fun _ -> createTestFail) testData true [] From da7451d329fb0db5d1a8630e496a09af874d7708 Mon Sep 17 00:00:00 2001 From: Phil Date: Thu, 1 Sep 2016 20:17:05 +0100 Subject: [PATCH 10/20] Added file options type that encapsulates aspects of file opening Created functions to produce default file opening options --- src/NovelIO/File.fs | 37 +++++++++++++++++++++++++++++-------- src/NovelIO/Prelude.fs | 4 ++++ 2 files changed, 33 insertions(+), 8 deletions(-) diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index 6a35629..a55c027 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -50,6 +50,27 @@ module private SideEffectingFileIO = /// Provides functions relating to the creating, copying, deleting, moving, opening and reading of files module File = + /// Options for opening a file + module Open = + /// A default set of options for reading a file + let defaultRead = { + FileMode = NovelFS.NovelIO.FileMode.Open; + FileAccess = NovelFS.NovelIO.FileAccess.Read; + IOMode = ChannelIOMode.Optimise + } + /// A default set of options for reading and writing a file + let defaultReadWrite = { + FileMode = NovelFS.NovelIO.FileMode.Create; + FileAccess = NovelFS.NovelIO.FileAccess.ReadWrite; + IOMode = ChannelIOMode.Optimise + } + /// A default set of options for writing a file + let defaultWrite = { + FileMode = NovelFS.NovelIO.FileMode.Create; + FileAccess = NovelFS.NovelIO.FileAccess.Write; + IOMode = ChannelIOMode.Optimise + } + /// Turns a string into a filename by assuming the supplied string is a valid filename. /// Throws an ArgumentException if the supplied string is, in fact, not valid. let assumeValidFilename path = @@ -110,20 +131,20 @@ module File = IO.fromEffectful (fun _ -> File.Move(getPathString sourceFile, getPathString destFile)) /// Opens a channel to the specified file using the supplied file mode - let openBinaryChannel mode access (fName : FilePath) = - IO.fromEffectful (fun _ -> SideEffectingFileIO.openBinaryFileChannel fName mode access) + let openBinaryChannel options (fName : FilePath) = + IO.fromEffectful (fun _ -> SideEffectingFileIO.openBinaryFileChannel fName options.FileMode options.FileAccess) /// Opens a channel to the specified file using the supplied file mode and performs the supplied computation fChannel with the channel before cleaning it up. - let withBinaryChannel mode access (fName : FilePath) fChannel = - IO.bracket (openBinaryChannel mode access fName) (BinaryChannel.close) fChannel + let withBinaryChannel options (fName : FilePath) fChannel = + IO.bracket (openBinaryChannel options fName) (BinaryChannel.close) fChannel /// Opens a channel to the specified file using the supplied file mode - let openTextChannel mode access (fName : FilePath) = - IO.fromEffectful (fun _ -> SideEffectingFileIO.openTextFileChannel fName mode access) + let openTextChannel options (fName : FilePath) = + IO.fromEffectful (fun _ -> SideEffectingFileIO.openTextFileChannel fName options.FileMode options.FileAccess) /// Opens a channel to the specified file using the supplied file mode and performs the supplied computation fChannel with the channel before cleaning it up. - let withTextChannel mode access (fName : FilePath) fChannel = - IO.bracket (openTextChannel mode access fName) (TextChannel.close) fChannel + let withTextChannel options (fName : FilePath) fChannel = + IO.bracket (openTextChannel options fName) (TextChannel.close) fChannel /// Reads all the bytes from a specified file as an array let readAllBytes filename = diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index cfba6c6..ef7c8b4 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -140,6 +140,10 @@ type ChannelIOMode = /// Use asychronous IO |Asynchronous +/// A set of options for opening a file +type FileOpenOptions = + {FileMode : FileMode; FileAccess : FileAccess; IOMode : ChannelIOMode} + /// A channel that may support text being read from it and written to it type TChannel = private { From a8478e0ce9f6e36c4b4152fed63036d514d1ebc9 Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Fri, 2 Sep 2016 00:42:05 +0100 Subject: [PATCH 11/20] Moved and renamed assumeValidFilename function into Path submodule in file module. Added tests for the new file open options. Large revisions and extensions to the documentation. --- docs/content/channels.fsx | 17 ++- docs/content/files.fsx | 18 ++- docs/content/index.fsx | 55 +++++++++- docs/content/motivation.fsx | 49 +-------- docs/content/oopintro.fsx | 88 +++++++++------ src/NovelIO/Channels.fs | 8 +- src/NovelIO/File.fs | 60 +++++----- src/NovelIO/IO.fs | 2 +- tests/NovelIO.IntegrationTests/FileTests.fs | 4 +- tests/NovelIO.UnitTests/FileTests.fs | 116 +++++++++++++------- 10 files changed, 235 insertions(+), 182 deletions(-) diff --git a/docs/content/channels.fsx b/docs/content/channels.fsx index 48ee835..7b107fa 100644 --- a/docs/content/channels.fsx +++ b/docs/content/channels.fsx @@ -35,15 +35,14 @@ An example is the `File.withTextChannel` function: *) -io { - let withChannelOR = File.withTextChannel FileMode.Open FileAccess.Read - return withChannelOR (File.assumeValidFilename "test.txt") (fun channel -> - io { - let! l1 = TextChannel.getLine channel - let! l2 = TextChannel.getLine channel - return l1, l2 - }) -} + +File.withTextChannel File.Open.defaultRead (File.Path.fromValid "test.txt") (fun channel -> + io { + let! l1 = TextChannel.getLine channel + let! l2 = TextChannel.getLine channel + return l1, l2 + }) + (** diff --git a/docs/content/files.fsx b/docs/content/files.fsx index 63a77ec..d052fb4 100644 --- a/docs/content/files.fsx +++ b/docs/content/files.fsx @@ -19,14 +19,14 @@ The first method of creating `Filepath`s is to use active patterns on a string, *) match "test.txt" with -|ValidFilename fName -> Some fName // do something with the valid filename -|InvalidFilename -> None // handle the invalid filename case +|ValidFilePath fName -> Some fName // do something with the valid filename +|InvalidFilePath -> None // handle the invalid filename case (** If we know that a conversion to a `Filepath` is definitely going to be succesful, we can instead use `File.assumeValidFilename` *) -let fName = File.assumeValidFilename "test.txt" +let fName = File.Path.fromValid "test.txt" (** Should we be mistaken about the supplied string being a valid filename, an `ArgumentException` will be thrown. @@ -37,23 +37,21 @@ The `File` modules contains functions very similar to `System.IO.File` defined i *) io { - let! lines = File.readLines fName + let! lines = File.readAllLines fName return lines } (** + ## File Channels If you need more fine-grained control over File IO, the way to achieve this is using Channels. Text and Binary Channels (`TChannels` and `BChannels`) support explicit reading and writing of their corresponding datatype. *) -let readLines file = - io { - let withChannelOR = File.withTextChannel FileMode.Open FileAccess.Read - return! withChannelOR file (fun channel -> - IO.Loops.untilM (TextChannel.isEOS channel) (TextChannel.getLine channel)) - } +let readFileUntilEnd path = + File.withTextChannel File.Open.defaultRead path (fun channel -> + IO.Loops.untilM (TextChannel.isEOF channel) (TextChannel.getLine channel)) (** diff --git a/docs/content/index.fsx b/docs/content/index.fsx index d857816..61f6e98 100644 --- a/docs/content/index.fsx +++ b/docs/content/index.fsx @@ -5,6 +5,8 @@ #r "NovelIO/NovelIO.dll" open NovelFS.NovelIO +let someAction = IO.return' () + (** Introduction ====================== @@ -125,18 +127,61 @@ let print1To10For = (** -It is possible to sequence I/O operations using the `io` computation expression. +A common task in File IO is performing a loop to retrieve lines from a file until you reach the end of the file. + +In this case, we can't use a simple `for` loop as we did previously because the logic for checking the loop end condition is also side effecting! Fortunately, we have another function for this occassion: + +*) + + +let readFileUntilEnd path = + File.withTextChannel File.Open.defaultRead path (fun channel -> + IO.Loops.untilM (TextChannel.isEOF channel) (TextChannel.getLine channel)) + +(** + +The `withTextChannel` encapsulates the lifetime of the text channel, accepting as an argument a function where we make use of the channel. + +In this function, we use the `untilM` combinator, its first argument is an `IO` condition and its second is an action to perform while the condition is `false`. + +It runs a `list` of all the results we generated from the action argument while the condition was `false`. + +## Parallel and Asychronous IO + +### Forking IO actions + +If you wish to perform some IO on another thread then `forkIO` is the function of choice. It simply performs the work on the .NET thread pool and doesn't ever return a result. + +*) + +io { + do! IO.forkIO someAction +} + +(** + +If you wished to perform a task and then retrieve the results later, you would need to use `forkTask` and `awaitTask`. + +*) + +io { + let! task = IO.forkTask <| IO.replicateM Random.nextIO 100 // create a task that generates some random numbers on the thread pool + let! results = IO.awaitTask task // await the completion of the task (await Task waits asychronously, it will not block threads) + return results +} + +(** -## Parallel IO +### Parallel actions -IO actions can also be performed in parallel using the `IO.parallel` combinators. This gives us very explicit, fine-grained, control over what actions should take place in parallel. +Entire lists of IO actions can be performed in parallel using the `IO.parallel` combinators. This gives us very explicit, fine-grained, control over what actions should take place in parallel. In order to execute items in parallel, we can simply build a list of the IO actions we wish to perform and use the `par` combinator. For example: *) io { - let fName = File.assumeValidFilename "file.txt" - let! channel = File.openTextChannel FileMode.Open FileAccess.Read fName + let fName = File.Path.fromValid "file.txt" + let! channel = File.openTextChannel File.Open.defaultRead fName return IO.Parallel.par [Console.readLine; TextChannel.getLine channel] } |> IO.run diff --git a/docs/content/motivation.fsx b/docs/content/motivation.fsx index 606e338..a27701c 100644 --- a/docs/content/motivation.fsx +++ b/docs/content/motivation.fsx @@ -17,7 +17,7 @@ Consider: *) -let x = 2*2 +let x = 2 * 2 (** @@ -177,52 +177,5 @@ io { So, using this approach we can easily describe either behaviour while still keeping the intent clear and explicit. -## Lazy evaluation and exceptions - -This example is more or less taken from Erik Meijer's Curse of the excluded middle (https://queue.acm.org/detail.cfm?ref=rss&id=2611829) - -Consider the following code where we try to combine lazy evaluation with File IO: - -*) - -let floatLines = - try - System.IO.File.ReadLines("testfile.txt") - |> Seq.map (float) // parse each line as a float - with - | _ -> Seq.empty - -Seq.iter (printfn "%f") floatLines // print each float to the console - -(** - -This code appears to be relatively safe - we have a comforting `try`/`with` block around a function that may fail at runtime. This code, however, does not function in the way it immediately appears to. - -In reality, the map is not actually evaluated until we enumerate the sequence with `Seq.iter`, this means that any exception, if triggered, will actually be thrown outside the `try`/`with` block causing the program to crash. - -Consider an alternative using NovelIO's expression of IO: - -*) - -let fName = File.assumeValidFilename "testfile.txt" - -let fileIO = io { - let! lines = File.readLines fName // sequence of io actions which each read a line from a file - let! floatLines = IO.mapM (IO.map float) lines // parse each line, collecting the results - do! IO.iterM (IO.putStrLn << sprintf "%f") floatLines // print each float to the console -} - -try - IO.run fileIO // side effects occur *only* on this line -with - |_ -> () // error case - - -(** - -This code describes exactly the same problem but we know that side-effects can occur in exactly one place `IO.run`. That means that success or failure need be handled in only that one location. We can therefore design complicated programs where IO is described using pure, referentially transparent functions and potentially error-prone behaviour is made very explicit and side-effects are restricted to very specific and obvious locations. - -Hopefully this demonstrates how being explicit about when effects occur can massively improve the ability of developers to understand and reason about their code. - *) diff --git a/docs/content/oopintro.fsx b/docs/content/oopintro.fsx index bc1373f..9659647 100644 --- a/docs/content/oopintro.fsx +++ b/docs/content/oopintro.fsx @@ -4,73 +4,93 @@ #I "../../bin" #r "NovelIO/NovelIO.dll" open NovelFS.NovelIO +open IO.Operators (** Introduction from an Object-Oriented Perspective ====================== -For those coming from an OOP background, the purpose of purely functional I/O might not seem immediately apparent. Two principles that might be familiar to developers more generally are: +For those coming from an OOP background, the purpose of purely functional I/O might not seem immediately apparent but in many cases, what would be regarded as "good practise" in the object oriented world is something we can simply have by construction using referentially transparent IO. -* Command–query separation -* The Principle of least astonishment +## Dependency Inversion -## Command-Query Seperation +In the OO world, you might design an interface to retrieve some resource. One implementation might touch the file system and then mock implementation would return test data for unit testing purposes. -Command-query seperation (CQS) is an imperative programming principle that says that each method should either be a Command or a Query. +*) -* Commands perform side effects but return no data, in F# terms they return `unit`. -* Queries return data to the caller, they must be referentially transparent (i.e. possess no side-effects). +type IResourceSupplier = + abstract member GetList : unit -> int list + +(** + +You can then pass the `IResourceSupplier` implementation to its consumers. + +Imagine we wished to add one to every number retrieved by our resource supplier, we might do this: *) - type ExampleClass = - /// Performs the side effect of writing text to the screen - member this.Command() = printfn "Hello World!" - /// Pure function that raises x to the power of 3 - member this.Query x = pown x 3 +let addOneToListFromSupplier (supplier : IResourceSupplier) = List.map ((+) 1) (supplier.GetList()) (** -## The Principle of Least Astonishment -The principle of least astonishment is more nebulously designed but it effectively states that the design of your software API should match the mental model of its user. Design decisions that take people by surprise are damaging because it will invariably result in them using the software incorrectly. +Of course, this still requires a trivial implementation that depends upon `IResourceSupplier`. + +The same thing can be achieved in IO via lifting a general function into io. -Command-query seperation helps to avoid astonishment on the part of the developer. They can see that functions which return `unit` do some side effect. +*) -The effect of CQS on queries is even more significant. If we don't follow the principle, there is really no way for our API users to see whether or not a function with a return value does some side-effect before returning the value or if the function is referentially transparent by contrast, following the principle means our API consumer knows that queries do not produce side-effects. +let addOneToList lst = List.map ((+) 1) lst // this function works on any old list, making it trivial to test -## A Better Alternative +let addOneToIOList lstIO = IO.map (addOneToList) lstIO // this function takes the above function and makes it operate on lists in IO. -While command-query seperation is a way of solving the problem, can we offer a better one? +(** -### Introducing `IO<'a>` +We have gained the same testability advantage as the OO dependency inversion with less boilerplate required to produce it. -Imagine two possible queries: +We can also see through the type system which function performs IO and which does not. That's a massive win for both readability and maintenance! + +## Command-Query Seperation + +Command-query seperation (CQS) is an imperative programming principle that says that each method should either be a Command or a Query. + +* Commands perform side effects but return no data, in F# terms they return `unit`. + +* Queries return data to the caller, they must be referentially transparent (i.e. possess no side-effects). -1. cube : A pure function that raises x to the power of 3 *) -let cube x = pown x 3 +type ExampleClass = + /// Performs the side effect of writing text to the screen + member this.Command() = printfn "Hello World!" + /// Pure function that raises x to the power of 3 + member this.Query x = pown x 3 (** -2. readIntFromFile : A function that gets an int from a file. + +CSQ has a laudable objective, to make it easier to reason about the way code behaves. + +Any time we see `unit` we know that an effect is happening and any time we see a value returned, we know we have no side-effects. Unfortunately, this pattern forbids common patterns like `random.Next()` which are ubiquitous in OO language standard library APIs. + +Now let's express these using NovelIO: + *) -open NovelFS.NovelIO.BinaryPickler +let exampleIO = Console.writeLine "Hello World!" -let readIntFromFile file = - io { - let! bytes = File.readAllBytes file - return BinaryPickler.unpickle (BinaryPickler.intPU) bytes - } +let query x = pown x 3 (** -It is worth looking at the type signatures of these functions. -`cube` simply has the type signature: `int -> int` +This looks very much the same as what we had before, exampleCommand is now of type `IO` instead of `unit -> unit`. But now lets look at the random example that we couldn't solve neatly using CQS: + +*) + +let randomIO = Random.nextIO + +(** -`readFloatFromFile` file, by contrast, has type signature: `Filename -> IO` +`randomIO` here has type `IO`. That provides a strong and clear distinction from the type of `query` which has type `int -> int`. -We can now quite clearly see that, even were it not obvious from the name, the second function is different. The fact that it needs to interact with the file system is now encoded in the type signature. +You can therefore think of referentially transparent IO as a more powerful version of CQS. -Hopefully this shows how we can use purely functional IO to make our coder richer but with less risk of astonishing our API users. *) \ No newline at end of file diff --git a/src/NovelIO/Channels.fs b/src/NovelIO/Channels.fs index ecbea23..8c879fb 100644 --- a/src/NovelIO/Channels.fs +++ b/src/NovelIO/Channels.fs @@ -78,8 +78,8 @@ module TextChannel = /// An action that reads a line from the text channel let getLine (channel : TChannel) = match channel.IOMode with - |ChannelIOMode.Synchronous -> IO.fromEffectful (fun _ -> SideEffecting.getLine channel) - |_ -> IO.liftAsync <| SideEffecting.getLineAsync channel + |ChannelIOMode.Asynchronous -> IO.liftAsync <| SideEffecting.getLineAsync channel + |_ -> IO.fromEffectful (fun _ -> SideEffecting.getLine channel) /// An action that determines if the text channel is at the end of the stream. This a synonym for isEOF let isEOS channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelAtEndOfStream channel) @@ -93,8 +93,8 @@ module TextChannel = /// An action that writes a line to the text channel let putStrLn (channel : TChannel) str = match channel.IOMode with - |ChannelIOMode.Synchronous -> IO.fromEffectful (fun _ -> SideEffecting.writeLine str channel) - |_ -> IO.liftAsync <| SideEffecting.writeLineAsync str channel + |ChannelIOMode.Asynchronous -> IO.liftAsync <| SideEffecting.writeLineAsync str channel + |_ -> IO.fromEffectful (fun _ -> SideEffecting.writeLine str channel) /// Operations on binary channels module BinaryChannel = diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index a55c027..4bec925 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -60,7 +60,7 @@ module File = } /// A default set of options for reading and writing a file let defaultReadWrite = { - FileMode = NovelFS.NovelIO.FileMode.Create; + FileMode = NovelFS.NovelIO.FileMode.OpenOrCreate; FileAccess = NovelFS.NovelIO.FileAccess.ReadWrite; IOMode = ChannelIOMode.Optimise } @@ -71,40 +71,42 @@ module File = IOMode = ChannelIOMode.Optimise } - /// Turns a string into a filename by assuming the supplied string is a valid filename. - /// Throws an ArgumentException if the supplied string is, in fact, not valid. - let assumeValidFilename path = - match path with - |ValidFilePath fname -> fname - |InvalidFilePath -> invalidArg "path" "Assumption of valid path was not correct." + /// Operations on File Paths + module Path = + /// Turns a string into a file path by assuming the supplied string is a valid file path. + /// Throws an ArgumentException if the supplied string is, in fact, not valid. + let fromValid path = + match path with + |ValidFilePath fname -> fname + |InvalidFilePath -> invalidArg "path" "Assumption of valid path was not correct." - /// Gets the bare string from a filename - let getPathString (filename : FilePath) = filename.PathString + /// Gets the bare string from a filename + let pathString (filename : FilePath) = filename.PathString /// Appends lines to a file, and then closes the file. If the specified file does not exist, this function creates a /// file, writes the specified lines to the file and then closes the file. let appendLines (lines : seq) filename = - IO.fromEffectful (fun _ -> File.AppendAllLines(getPathString filename, lines)) + IO.fromEffectful (fun _ -> File.AppendAllLines(Path.pathString filename, lines)) /// Copies an existing file to a location specified. Overwriting is not allowed let copy sourceFile destFile = - IO.fromEffectful (fun _ -> File.Copy(getPathString sourceFile, getPathString destFile)) + IO.fromEffectful (fun _ -> File.Copy(Path.pathString sourceFile, Path.pathString destFile)) /// Determines the creation date / time of the specified file let creationTime filename = - IO.fromEffectful (fun _ -> File.GetCreationTime <| getPathString filename) + IO.fromEffectful (fun _ -> File.GetCreationTime <| Path.pathString filename) /// Determines the UTC creation date / time of the specified file let creationTimeUTC filename = - IO.fromEffectful (fun _ -> File.GetCreationTimeUtc <| getPathString filename) + IO.fromEffectful (fun _ -> File.GetCreationTimeUtc <| Path.pathString filename) /// Deletes the specified file let delete filename = - IO.fromEffectful (fun _ -> File.Delete <| getPathString filename) + IO.fromEffectful (fun _ -> File.Delete <| Path.pathString filename) /// Determines whether or not the specified file exists let exists filename = - IO.fromEffectful (fun _ -> File.Exists <| getPathString filename) + IO.fromEffectful (fun _ -> File.Exists <| Path.pathString filename) /// Determines whether or not the specified file is readonly let isReadOnly filename = @@ -112,23 +114,23 @@ module File = /// Determines the date / time at which the specified file was last accessed let lastAccessTime filename = - IO.fromEffectful (fun _ -> File.GetLastAccessTime <| getPathString filename) + IO.fromEffectful (fun _ -> File.GetLastAccessTime <| Path.pathString filename) /// Determines the UTC date / time at which the specified file was last accessed let lastAccessTimeUTC filename = - IO.fromEffectful (fun _ -> File.GetLastAccessTimeUtc <| getPathString filename) + IO.fromEffectful (fun _ -> File.GetLastAccessTimeUtc <| Path.pathString filename) /// Determines the date / time at which the specified file was last written let lastWriteTime filename = - IO.fromEffectful (fun _ -> File.GetLastWriteTime <| getPathString filename) + IO.fromEffectful (fun _ -> File.GetLastWriteTime <| Path.pathString filename) /// Determines the UTC date / time at which the specified file was last written let lastWriteTimeUTC filename = - IO.fromEffectful (fun _ -> File.GetLastWriteTimeUtc <| getPathString filename) + IO.fromEffectful (fun _ -> File.GetLastWriteTimeUtc <| Path.pathString filename) /// Moves an existing file to a location specified. Overwriting is not allowed let move sourceFile destFile = - IO.fromEffectful (fun _ -> File.Move(getPathString sourceFile, getPathString destFile)) + IO.fromEffectful (fun _ -> File.Move(Path.pathString sourceFile, Path.pathString destFile)) /// Opens a channel to the specified file using the supplied file mode let openBinaryChannel options (fName : FilePath) = @@ -148,39 +150,39 @@ module File = /// Reads all the bytes from a specified file as an array let readAllBytes filename = - IO.fromEffectful(fun _ -> File.ReadAllBytes <| getPathString filename) + IO.fromEffectful(fun _ -> File.ReadAllBytes <| Path.pathString filename) /// Reads all the lines from a file. let readAllLines filename = - IO.fromEffectful (fun _ -> List.ofArray << File.ReadAllLines <| getPathString filename) + IO.fromEffectful (fun _ -> List.ofArray << File.ReadAllLines <| Path.pathString filename) /// Reads all the lines from a file in the supplied encoding. let readAllLinesIn encoding filename = - IO.fromEffectful (fun _ -> List.ofArray <| File.ReadAllLines (getPathString filename, Encoding.createDotNetEncoding encoding)) + IO.fromEffectful (fun _ -> List.ofArray <| File.ReadAllLines (Path.pathString filename, Encoding.createDotNetEncoding encoding)) /// Sets the date / time at which the specified file was created let setCreationTime datetime filename = - IO.fromEffectful (fun _ -> File.SetCreationTime(getPathString filename, datetime)) + IO.fromEffectful (fun _ -> File.SetCreationTime(Path.pathString filename, datetime)) /// Sets the UTC date / time at which the specified file was created let setCreationTimeUTC datetime filename = - IO.fromEffectful (fun _ -> File.SetCreationTimeUtc(getPathString filename, datetime)) + IO.fromEffectful (fun _ -> File.SetCreationTimeUtc(Path.pathString filename, datetime)) /// Sets the date / time at which the specified file was last accessed let setLastAccessTime datetime filename = - IO.fromEffectful (fun _ -> File.SetLastAccessTime(getPathString filename, datetime)) + IO.fromEffectful (fun _ -> File.SetLastAccessTime(Path.pathString filename, datetime)) /// Sets the UTC date / time at which the specified file was last accessed let setLastAccessTimeUTC datetime filename = - IO.fromEffectful (fun _ -> File.SetLastAccessTimeUtc(getPathString filename, datetime)) + IO.fromEffectful (fun _ -> File.SetLastAccessTimeUtc(Path.pathString filename, datetime)) /// Sets the date / time at which the specified file was last written let setLastWriteTime datetime filename = - IO.fromEffectful (fun _ -> File.SetLastWriteTime(getPathString filename, datetime)) + IO.fromEffectful (fun _ -> File.SetLastWriteTime(Path.pathString filename, datetime)) /// Sets the UTC date / time at which the specified file was last written let setLastWriteTimeUTC datetime filename = - IO.fromEffectful (fun _ -> File.SetLastWriteTimeUtc(getPathString filename, datetime)) + IO.fromEffectful (fun _ -> File.SetLastWriteTimeUtc(Path.pathString filename, datetime)) /// Determines the size of the specified file in bytes let size filename = diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 902333a..0609222 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -359,7 +359,7 @@ module IO = let par_ (ios : IO<_> list) = map (ignore) (par ios) - /// mapConcurrently is similar to mapM but where each of the IO actions in the sequence are performed in parallel + /// mapConcurrently is similar to traverse but where each of the IO actions in the sequence are performed in parallel let mapConcurrently (f : 'a -> IO<'b>) sequ = List.map f sequ |> par diff --git a/tests/NovelIO.IntegrationTests/FileTests.fs b/tests/NovelIO.IntegrationTests/FileTests.fs index 0a6239d..3edad06 100644 --- a/tests/NovelIO.IntegrationTests/FileTests.fs +++ b/tests/NovelIO.IntegrationTests/FileTests.fs @@ -27,7 +27,7 @@ type ``File Integration Tests``() = static member ``Read All Bytes from file`` (bytes : byte[]) = let fnameStr = "readbytestest.tst" System.IO.File.WriteAllBytes(fnameStr, bytes) - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.readAllBytes fname = bytes [] @@ -38,7 +38,7 @@ type ``File Integration Tests``() = |> Array.collect (fun str -> str.Get.Split('\r','\n')) |> List.ofArray System.IO.File.WriteAllLines(fnameStr, lstStrs) - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr let lineIO = io { return! File.readAllLines fname diff --git a/tests/NovelIO.UnitTests/FileTests.fs b/tests/NovelIO.UnitTests/FileTests.fs index 12e2dd1..3ce3eb3 100644 --- a/tests/NovelIO.UnitTests/FileTests.fs +++ b/tests/NovelIO.UnitTests/FileTests.fs @@ -28,30 +28,66 @@ type ``File Unit Tests``() = |> Seq.find (not << System.IO.File.Exists) [] - static member ``Function: assumeValidFilename returns a valid filename for a valid file path``() = + static member ``File.Path.fromValid returns a valid filename for a valid file path``() = let fnameStr = System.IO.Path.GetRandomFileName() - let fname = File.assumeValidFilename fnameStr // throws exception in failure case + let fname = File.Path.fromValid fnameStr // throws exception in failure case true [] - static member ``Function: assumeValidFilename throws exception for an invalid file path``() = + static member ``File.Path.fromValid throws exception for an invalid file path``() = let invStr = string << Array.head <| System.IO.Path.GetInvalidFileNameChars() let fnameStr = System.IO.Path.GetRandomFileName() + invStr try - let fname = File.assumeValidFilename fnameStr // throws exception in failure case + let fname = File.Path.fromValid fnameStr // throws exception in failure case failwith "path was not expected to be valid" with | :? System.ArgumentException as aex -> true [] - static member ``ValidFilename path disciminator matches for a valid file path``() = + static member ``File.Open.defaultRead has FileMode.Open``() = + match File.Open.defaultRead.FileMode with + |FileMode.Open -> true + |_ -> false + + [] + static member ``File.Open.defaultRead has FileAccess.Read``() = + match File.Open.defaultRead.FileAccess with + |FileAccess.Read -> true + |_ -> false + + [] + static member ``File.Open.defaultReadWrite has FileMode.OpenOrCreate``() = + match File.Open.defaultReadWrite.FileMode with + |FileMode.OpenOrCreate -> true + |_ -> false + + [] + static member ``File.Open.defaultReadWrite has FileAccess.ReadWrite``() = + match File.Open.defaultReadWrite.FileAccess with + |FileAccess.ReadWrite -> true + |_ -> false + + [] + static member ``File.Open.defaultWrite has FileMode.Create``() = + match File.Open.defaultWrite.FileMode with + |FileMode.Create -> true + |_ -> false + + [] + static member ``File.Open.defaultWrite has FileAccess.ReadWrite``() = + match File.Open.defaultWrite.FileAccess with + |FileAccess.Write -> true + |_ -> false + + [] + static member ``ValidFilePath path disciminator matches for a valid file path``() = let fnameStr = System.IO.Path.GetRandomFileName() match fnameStr with |ValidFilePath fname -> true |InvalidFilePath -> failwith "path was expected not be invalid" [] - static member ``InvalidFilename path disciminator matches for a invalid file path``() = + static member ``ValidFilePath path disciminator matches for a invalid file path``() = let invStr = string << Array.head <| System.IO.Path.GetInvalidFileNameChars() let fnameStr = System.IO.Path.GetRandomFileName() + invStr match fnameStr with @@ -59,93 +95,93 @@ type ``File Unit Tests``() = |InvalidFilePath -> true [] - static member ``Function: getPathString returns contained path string``() = + static member ``File.Path.pathString returns contained path string``() = let fnameStr = System.IO.Path.GetRandomFileName() - let fname = File.assumeValidFilename fnameStr - File.getPathString fname = fnameStr + let fname = File.Path.fromValid fnameStr + File.Path.pathString fname = fnameStr [] - static member ``Function: creationTime returns correct date/time for test file``() = + static member ``File.creationTime returns correct date/time for test file``() = let fnameStr = "creationtimetest.txt" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.creationTime fname = System.IO.File.GetCreationTime fnameStr [] - static member ``Function: creationTimeUTC returns correct date/time for test file``() = + static member ``File.creationTimeUTC returns correct date/time for test file``() = let fnameStr = "creationtimetest.txt" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.creationTimeUTC fname = System.IO.File.GetCreationTimeUtc fnameStr [] - static member ``Function: lastAccessTime returns correct date/time for test file``() = + static member ``File.lastAccessTime returns correct date/time for test file``() = let fnameStr = "creationtimetest.txt" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.lastAccessTime fname = System.IO.File.GetLastAccessTime fnameStr [] - static member ``Function: lastAccessTimeUTC returns correct date/time for test file``() = + static member ``File.lastAccessTimeUTC returns correct date/time for test file``() = let fnameStr = "creationtimetest.txt" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.lastAccessTimeUTC fname = System.IO.File.GetLastAccessTimeUtc fnameStr [] - static member ``Function: lastWriteTime returns correct date/time for test file``() = + static member ``File.lastWriteTime returns correct date/time for test file``() = let fnameStr = "creationtimetest.txt" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.lastWriteTime fname = System.IO.File.GetLastWriteTime fnameStr [] - static member ``Function: lastWriteTimeUTC returns correct date/time for test file``() = + static member ``File.lastWriteTimeUTC returns correct date/time for test file``() = let fnameStr = "creationtimetest.txt" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.lastWriteTimeUTC fname = System.IO.File.GetLastWriteTimeUtc fnameStr [] - static member ``Function: setCreationTime sets correct date/time for test file`` (dt : System.DateTime) = + static member ``File.setCreationTime sets correct date/time for test file`` (dt : System.DateTime) = let fnameStr = """creationtimetestwriting.txt""" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.setCreationTime dt fname dt = System.IO.File.GetCreationTime fnameStr [] - static member ``Function: setCreationTimeUTC sets correct date/time for test file`` (dt : System.DateTime) = + static member ``File.setCreationTimeUTC sets correct date/time for test file`` (dt : System.DateTime) = let fnameStr = """creationtimetestwriting.txt""" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.setCreationTimeUTC dt fname dt = System.IO.File.GetCreationTimeUtc fnameStr [] - static member ``Function: setLastAccessTime sets correct date/time for test file`` (dt : System.DateTime) = + static member ``File.setLastAccessTime sets correct date/time for test file`` (dt : System.DateTime) = let fnameStr = """creationtimetestwriting.txt""" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.setLastAccessTime dt fname dt = System.IO.File.GetLastAccessTime fnameStr [] - static member ``Function: setLastAccessTimeUTC sets correct date/time for test file`` (dt : System.DateTime) = + static member ``File.setLastAccessTimeUTC sets correct date/time for test file`` (dt : System.DateTime) = let fnameStr = """creationtimetestwriting.txt""" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.setLastAccessTimeUTC dt fname dt = System.IO.File.GetLastAccessTimeUtc fnameStr [] - static member ``Function: setLastWriteTime sets correct date/time for test file`` (dt : System.DateTime) = + static member ``File.setLastWriteTime sets correct date/time for test file`` (dt : System.DateTime) = let fnameStr = """creationtimetestwriting.txt""" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.setLastWriteTime dt fname dt = System.IO.File.GetLastWriteTime fnameStr [] - static member ``Function: setLastWriteTimeUTC sets correct date/time for test file`` (dt : System.DateTime) = + static member ``File.setLastWriteTimeUTC sets correct date/time for test file`` (dt : System.DateTime) = let fnameStr = """creationtimetestwriting.txt""" - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.setLastWriteTimeUTC dt fname dt = System.IO.File.GetLastWriteTimeUtc fnameStr [] static member ``File that does not exist is not found``() = let fnameStr = firstRandomFileThatDoesNotExist() - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr not << IO.run <| File.exists fname [] @@ -153,7 +189,7 @@ type ``File Unit Tests``() = let fnameStr = firstRandomFileThatDoesNotExist() System.IO.File.WriteAllLines(fnameStr, [|""|]) try - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr IO.run <| File.exists fname finally System.IO.File.Delete fnameStr @@ -161,7 +197,7 @@ type ``File Unit Tests``() = [] static member ``Random file can be deleted``() = let fnameStr = firstRandomFileThatDoesNotExist() - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr System.IO.File.AppendAllLines(fnameStr, [""]) IO.run <| File.delete fname not <| System.IO.File.Exists fnameStr @@ -169,10 +205,10 @@ type ``File Unit Tests``() = [] static member ``Random file can be copied``() = let fnameStr = firstRandomFileThatDoesNotExist() - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr System.IO.File.AppendAllLines(fnameStr, [""]) let fnameStr2 = firstRandomFileThatDoesNotExist() - let fname2 = File.assumeValidFilename fnameStr2 + let fname2 = File.Path.fromValid fnameStr2 IO.run <| File.copy fname fname2 try System.IO.File.Exists fnameStr2 @@ -184,10 +220,10 @@ type ``File Unit Tests``() = [] static member ``Random file can be moved``() = let fnameStr = firstRandomFileThatDoesNotExist() - let fname = File.assumeValidFilename fnameStr + let fname = File.Path.fromValid fnameStr System.IO.File.AppendAllLines(fnameStr, [""]) let fnameStr2 = firstRandomFileThatDoesNotExist() - let fname2 = File.assumeValidFilename fnameStr2 + let fname2 = File.Path.fromValid fnameStr2 try IO.run <| File.move fname fname2 try From b48d9d6c1c3182855db1fb3824e4a998e2379081 Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Fri, 2 Sep 2016 01:27:45 +0100 Subject: [PATCH 12/20] More documentation Improved naming for Parallel module --- docs/content/oopintro.fsx | 16 +++++++++++----- src/NovelIO/IO.fs | 36 +++++++++++++++++++++--------------- 2 files changed, 32 insertions(+), 20 deletions(-) diff --git a/docs/content/oopintro.fsx b/docs/content/oopintro.fsx index 9659647..97244dd 100644 --- a/docs/content/oopintro.fsx +++ b/docs/content/oopintro.fsx @@ -25,17 +25,21 @@ type IResourceSupplier = You can then pass the `IResourceSupplier` implementation to its consumers. -Imagine we wished to add one to every number retrieved by our resource supplier, we might do this: +Imagine we wished to add one to every number retrieved by our resource supplier so we decide to use a constructor injected dependency. *) -let addOneToListFromSupplier (supplier : IResourceSupplier) = List.map ((+) 1) (supplier.GetList()) +type Adder(supplier : IResourceSupplier) = + member this.AddOne = List.map ((+) 1) (supplier.GetList()) + (** -Of course, this still requires a trivial implementation that depends upon `IResourceSupplier`. +This class is now pretty easy to test, we just use a custom `IResourceSupplier` implementation and we can test the logic that the `Adder` class performs in isolation of its dependency. + +Of course, we've had to add quite a bit of boilerplate to actually get to this point. -The same thing can be achieved in IO via lifting a general function into io. +Exactly the same results can be achieved in IO by lifting a pure function into IO. *) @@ -45,7 +49,9 @@ let addOneToIOList lstIO = IO.map (addOneToList) lstIO // this function takes th (** -We have gained the same testability advantage as the OO dependency inversion with less boilerplate required to produce it. +`IO.map` can take any function of the form `'a -> 'b` and return an `IO<'a> -> IO<'b>`, allowing our previously pure function to easily operate within IO. + +We have gained the same testability advantage as the OO dependency inversion example with less boilerplate required to actually realise it. We can also see through the type system which function performs IO and which does not. That's a massive win for both readability and maintenance! diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 0609222..5c7a360 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -274,15 +274,15 @@ module IO = |> map (List.rev) /// Execute an action repeatedly as long as the given boolean IO action returns true - let iterWhileM (pAct : IO) (f : IO<'a>) = + let iterWhileM (pAct : IO) (act : IO<'a>) = let rec whileMRec() = - io { - let! p = pAct + io { // check the predicate action + let! p = pAct match p with - |true -> - let! x = f + |true -> // unwrap the current action value then recurse + let! x = act return! whileMRec() - |false -> return () + |false -> return () // finished } whileMRec () @@ -342,10 +342,20 @@ module IO = // ------ Parallel ------ // /// Parallel IO combinators + [] module Parallel = + /// Executes the given IO actions in parallel and ignores the result. + let iterSequence (ios : IO<_> list) = + let allIOTasks = + ios + |> Array.ofList + |> Array.map (forkIO) + |> List.ofArray + |> sequence + allIOTasks >>= (return' << ignore) - /// Executes the given IO actions in parallel - let par (ios : IO<'a> list) = + /// Executes the given IO actions in parallel. + let sequence (ios : IO<'a> list) = let allIOTasks = ios |> Array.ofList @@ -355,14 +365,10 @@ module IO = |> map (System.Threading.Tasks.Task.WhenAll) map (List.ofArray) (allIOTasks >>= awaitTask) - /// Executes the given IO actions in parallel and ignores the result - let par_ (ios : IO<_> list) = - map (ignore) (par ios) - - /// mapConcurrently is similar to traverse but where each of the IO actions in the sequence are performed in parallel - let mapConcurrently (f : 'a -> IO<'b>) sequ = + /// Map each element in a list to a monadic action and then run all of those monadic actions in parallel. + let traverse (f : 'a -> IO<'b>) sequ = List.map f sequ - |> par + |> sequence /// Module to provide the definition of the io computation expression [] From 2686685e2dc89e9e67c785b76cfab57adede957a Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Fri, 2 Sep 2016 13:52:17 +0100 Subject: [PATCH 13/20] Added test for left and right sequence actions operators --- .../NovelIO.UnitTests.fsproj | 1 + tests/NovelIO.UnitTests/OperatorTests.fs | 53 +++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 tests/NovelIO.UnitTests/OperatorTests.fs diff --git a/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj b/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj index c241493..799ac75 100644 --- a/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj +++ b/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj @@ -60,6 +60,7 @@ + PreserveNewest diff --git a/tests/NovelIO.UnitTests/OperatorTests.fs b/tests/NovelIO.UnitTests/OperatorTests.fs new file mode 100644 index 0000000..33423ef --- /dev/null +++ b/tests/NovelIO.UnitTests/OperatorTests.fs @@ -0,0 +1,53 @@ +(* + Copyright 2015-2016 Philip Curzon + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +namespace NovelFS.NovelIO.UnitTests + +open NovelFS.NovelIO +open NovelFS.NovelIO.IO.Operators +open FsCheck +open FsCheck.Xunit + +type ``IO Operator Tests``() = + [] + static member ``*> operator does action on left, then action on right and returns result of action on right`` () = + let x = ref 0 + let addAction = IO.fromEffectful (fun _ -> + x := !x + 3 + 10) + let multAction = IO.fromEffectful (fun _ -> + x := !x * 3 + 1) + let act = addAction *> multAction + let result = IO.run act + result = 1 && !x = 9 // 9 confirms the order since 0 + 3 * 3 = 9 but 0 * 3 + 3 = 3 + + [] + static member ``<* operator does action on left, then action on right and returns result of action on left`` () = + let x = ref 0 + let addAction = IO.fromEffectful (fun _ -> + x := !x + 3 + 10) + let multAction = IO.fromEffectful (fun _ -> + x := !x * 3 + 1) + let act = addAction <* multAction + let result = IO.run act + result = 10 && !x = 9 // 9 confirms the order since 0 + 3 * 3 = 9 but 0 * 3 + 3 = 3 + + + + From cba67913ebc0c5f6beb8ed7b1c9be4ded2016dd2 Mon Sep 17 00:00:00 2001 From: Phil Date: Sat, 3 Sep 2016 11:37:49 +0100 Subject: [PATCH 14/20] Changed *> operator to >>. and <* operator to .>> - this clarifies that in both cases, actions are performed left to right Added operator documentation --- NovelIO.sln | 1 + docs/content/operators.fsx | 145 +++++++++++++++++++++++ docs/tools/templates/template.cshtml | 1 + src/NovelIO/IO.fs | 4 +- tests/NovelIO.UnitTests/OperatorTests.fs | 18 ++- 5 files changed, 162 insertions(+), 7 deletions(-) create mode 100644 docs/content/operators.fsx diff --git a/NovelIO.sln b/NovelIO.sln index 7bbad40..0709d5e 100644 --- a/NovelIO.sln +++ b/NovelIO.sln @@ -30,6 +30,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "content", "content", "{8E6D docs\content\index.fsx = docs\content\index.fsx docs\content\motivation.fsx = docs\content\motivation.fsx docs\content\oopintro.fsx = docs\content\oopintro.fsx + docs\content\operators.fsx = docs\content\operators.fsx docs\content\pickler.fsx = docs\content\pickler.fsx docs\content\tutorial.fsx = docs\content\tutorial.fsx EndProjectSection diff --git a/docs/content/operators.fsx b/docs/content/operators.fsx new file mode 100644 index 0000000..3b11a4c --- /dev/null +++ b/docs/content/operators.fsx @@ -0,0 +1,145 @@ +(*** hide ***) +// This block of code is omitted in the generated HTML documentation. Use +// it to define helpers that you do not want to show in the documentation. +#I "../../bin" +#r "NovelIO/NovelIO.dll" +open NovelFS.NovelIO + +(** +Operator reference +====================== + +A set of useful operators are provided in the `IO.Operators` module. + +*) + +open IO.Operators + +(** +## Bind Operator + +Bind is the most fundamental way of sequencing IO actions, it takes an IO action and a function that operates on the result of the first IO action and returns a new IO action. + +Example function defintion: + +*) + +let bind x f = + io { + let! x' = x + return! f x' + } + +(** +Example use - reading a line from the console and then writing it back out: +*) + +let readWriteLine = bind Console.readLine (fun l -> Console.writeLine l) + +(** +Example operator use: +*) + +let readWriteLine' = Console.readLine >>= (fun l -> Console.writeLine l) + +(** + +## Map Operator + +The map operator allows you to transform IO actions using an ordinary function. + +Example function defintion: + +*) + +let map f x = + io { + let! x' = x + return f x' + } + +(** +Example use - reading a line from the console and parsing it as an int: +*) + +let readIntLine = map (fun l -> int l) Console.readLine + +(** +Example operator use: +*) + +let readIntLine' = (fun l -> int l) Console.readLine +let readIntLine'' = int Console.readLine + +(** + +## Apply Operator + +The apply operator allows functions within `IO` to operate on actions. + +Example function defintion: + +*) + +let apply f x = bind f (fun fe -> map fe x) + +(** +Example use - creating a tuple from two strings read from the console: +*) + +let readTupleString = apply (map (fun a b -> a,b) Console.readLine) Console.readLine + +let readTupleString' = (fun a b -> a,b) Console.readLine <*> Console.readLine + +(** +This is a very powerful pattern because the pattern holds for arbitrarily large functions just by adding more uses of `<*>`. +*) + +let readTuple2String = (fun a b -> a,b) Console.readLine <*> Console.readLine + +let readTuple3String = (fun a b c -> a,b,c) Console.readLine <*> Console.readLine <*> Console.readLine + +let readTuple4String = (fun a b c d -> a,b,c,d) Console.readLine <*> Console.readLine <*> Console.readLine <*> Console.readLine + +(** +In general, this pattern allows you to take any pure function and apply it as a transformation to the results of IO actions. + +## Sequence Actions Operators + +The sequence operators `>>.` and `.>>` allow you to perform a pair of actions and return the result from only one of them. + +Example function defintion: + +*) + +let sequenceFirst x y = + io { + let! x' = x + let! y' = y + return x' + } + +let sequenceSecond x y = + io { + let! x' = x + let! y' = y + return y' + } + +(** +Example use - writing a fixed string to the console and reading a line: +*) + +let readWrite = sequenceFirst Console.readLine (Console.writeLine "Complete.") + +let writeRead = sequenceSecond (Console.writeLine "Please enter some input:") Console.readLine + +(** +Example operator use: +*) + +let readWrite' = Console.readLine .>> (Console.writeLine "Complete.") + +let writeRead' = (Console.writeLine "Please enter some input:") >>. Console.readLine + + diff --git a/docs/tools/templates/template.cshtml b/docs/tools/templates/template.cshtml index 7cabda6..0b11107 100644 --- a/docs/tools/templates/template.cshtml +++ b/docs/tools/templates/template.cshtml @@ -51,6 +51,7 @@
  • Using the Pickler Combinator
  • Channels
  • Documentation
    • +
  • Operator Reference
  • API Reference
    • diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 5c7a360..b9baa73 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -123,9 +123,9 @@ module IO = /// Apply operator for IO actions let inline (<*>) (f : IO<'a -> 'b>) (x : IO<'a>) = apply f x /// Sequence actions, discarding the value of the first argument. - let inline ( *> ) u v = return' (const' id) <*> u <*> v + let inline ( >>. ) u v = return' (const' id) <*> u <*> v /// Sequence actions, discarding the value of the second argument. - let inline ( <* ) u v = return' const' <*> u <*> v + let inline ( .>> ) u v = return' const' <*> u <*> v /// Monadic bind operator for IO actions let inline (>>=) x f = bind x f /// Left to right Kleisli composition of IO actions, allows composition of binding functions diff --git a/tests/NovelIO.UnitTests/OperatorTests.fs b/tests/NovelIO.UnitTests/OperatorTests.fs index 33423ef..cc90759 100644 --- a/tests/NovelIO.UnitTests/OperatorTests.fs +++ b/tests/NovelIO.UnitTests/OperatorTests.fs @@ -23,7 +23,7 @@ open FsCheck.Xunit type ``IO Operator Tests``() = [] - static member ``*> operator does action on left, then action on right and returns result of action on right`` () = + static member ``>>. operator does action on left, then action on right and returns result of action on right`` () = let x = ref 0 let addAction = IO.fromEffectful (fun _ -> x := !x + 3 @@ -31,12 +31,12 @@ type ``IO Operator Tests``() = let multAction = IO.fromEffectful (fun _ -> x := !x * 3 1) - let act = addAction *> multAction + let act = addAction >>. multAction let result = IO.run act result = 1 && !x = 9 // 9 confirms the order since 0 + 3 * 3 = 9 but 0 * 3 + 3 = 3 [] - static member ``<* operator does action on left, then action on right and returns result of action on left`` () = + static member ``.>> operator does action on left, then action on right and returns result of action on left`` () = let x = ref 0 let addAction = IO.fromEffectful (fun _ -> x := !x + 3 @@ -44,10 +44,18 @@ type ``IO Operator Tests``() = let multAction = IO.fromEffectful (fun _ -> x := !x * 3 1) - let act = addAction <* multAction + let act = addAction .>> multAction let result = IO.run act result = 10 && !x = 9 // 9 confirms the order since 0 + 3 * 3 = 9 but 0 * 3 + 3 = 3 - + [] + static member `` operator for (+) on IO int returns same as addition`` (num : int) = + let additionIO = ((+) 5) (IO.return' num) + IO.run additionIO = num + 5 + + [] + static member ``<*> operator for (+) on IO int returns same as addition`` (num1 : int, num2 : int) = + let additionIO = (+) (IO.return' num1) <*> (IO.return' num2) + IO.run additionIO = num1 + num2 From 464a34aa2a69a16e9f9324435e1eb6e4ca33c057 Mon Sep 17 00:00:00 2001 From: Phil Date: Sat, 3 Sep 2016 11:44:36 +0100 Subject: [PATCH 15/20] Replaced file access/mode types with abbreviations of the standard .NET IO enums. Added file share abbreviation Added file share to FileOpenOptions record --- src/NovelIO/File.fs | 15 +++++++++------ src/NovelIO/Prelude.fs | 34 ++++++++++------------------------ 2 files changed, 19 insertions(+), 30 deletions(-) diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index 4bec925..a056bf8 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -54,20 +54,23 @@ module File = module Open = /// A default set of options for reading a file let defaultRead = { - FileMode = NovelFS.NovelIO.FileMode.Open; - FileAccess = NovelFS.NovelIO.FileAccess.Read; + FileMode = NovelFS.NovelIO.FileMode.Open; + FileAccess = NovelFS.NovelIO.FileAccess.Read; + FileShare = NovelFS.NovelIO.FileShare.Read; IOMode = ChannelIOMode.Optimise } /// A default set of options for reading and writing a file let defaultReadWrite = { - FileMode = NovelFS.NovelIO.FileMode.OpenOrCreate; - FileAccess = NovelFS.NovelIO.FileAccess.ReadWrite; + FileMode = NovelFS.NovelIO.FileMode.OpenOrCreate; + FileAccess = NovelFS.NovelIO.FileAccess.ReadWrite; + FileShare = NovelFS.NovelIO.FileShare.Read; IOMode = ChannelIOMode.Optimise } /// A default set of options for writing a file let defaultWrite = { - FileMode = NovelFS.NovelIO.FileMode.Create; - FileAccess = NovelFS.NovelIO.FileAccess.Write; + FileMode = NovelFS.NovelIO.FileMode.Create; + FileAccess = NovelFS.NovelIO.FileAccess.Write; + FileShare = NovelFS.NovelIO.FileShare.Read; IOMode = ChannelIOMode.Optimise } diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index ef7c8b4..e826735 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -104,31 +104,17 @@ module General = /// Converts a curried function to a function on pairs. let inline uncurry f (a, b) = f a b -/// Specifies how the operating system should open a file +/// Type abbreviation for System.IO.FileMode [] -type FileMode = - /// Specifies that a new file should be created. If the file already exists, an IOException will be thrown. - |CreateNew - /// Specifies that a new file should be created. If the file already exists, it will be overwritten. - |Create - /// Specifies that an existing file should be opened. - |Open - /// Specifies that an existing file should be opened. If the file does not exist, it will be created. - |OpenOrCreate - /// Specifies that an existing file should be opened but that, once opened, it should be truncated to zero bytes. - |Truncate - /// Specifies that an existing file should be opened and the end of the file sought. If the file does not exist, it will be created. - |Append - -/// Defines the type of access to a file +type FileMode = System.IO.FileMode + +/// Type abbreviation for System.IO.FileAccess +[] +type FileAccess = System.IO.FileAccess + +/// Type abbreviation for System.IO.FileShare [] -type FileAccess = - /// Read access to a file - |Read - /// Write access to a file - |Write - /// Read and write access to a file - |ReadWrite +type FileShare = System.IO.FileShare /// Defines the IO mode of a channel [] @@ -142,7 +128,7 @@ type ChannelIOMode = /// A set of options for opening a file type FileOpenOptions = - {FileMode : FileMode; FileAccess : FileAccess; IOMode : ChannelIOMode} + {FileMode : FileMode; FileAccess : FileAccess; FileShare: FileShare; IOMode : ChannelIOMode} /// A channel that may support text being read from it and written to it type TChannel = From 17650ad2fe787b2f5c1b016967175508742de473 Mon Sep 17 00:00:00 2001 From: Phil Date: Sat, 3 Sep 2016 12:27:53 +0100 Subject: [PATCH 16/20] Removed unneeded conversion functions Removed putStrLn from IO Removed IO result from prelude Added result type abbreviation --- src/NovelIO/File.fs | 4 ++-- src/NovelIO/Helper.fs | 30 +++--------------------------- src/NovelIO/IO.fs | 5 +---- src/NovelIO/Prelude.fs | 39 +++++++-------------------------------- 4 files changed, 13 insertions(+), 65 deletions(-) diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index a056bf8..8aa3908 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -35,7 +35,7 @@ module private SideEffectingFileIO = let openTextFileChannel (fName : FilePath) mode access = let crTxtRdr (fStream : FileStream) = new StreamReader(fStream) let crTxtWrtr (fStream : FileStream) = new StreamWriter(fStream) - let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access, FileShare.Read, 4096, true) + let fStream = new FileStream(fName.PathString, mode, access, FileShare.Read, 4096, true) let (reader, writer) = match access with |NovelFS.NovelIO.FileAccess.Read -> Some <| crTxtRdr fStream, None @@ -45,7 +45,7 @@ module private SideEffectingFileIO = /// Create a binary file channel for a supplied file name, file mode and file access let openBinaryFileChannel (fName : FilePath) mode access = - let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) + let fStream = new FileStream(fName.PathString, mode, access) {IOStream = fStream; IOMode = ChannelIOMode.Optimise; EOS = false} /// Provides functions relating to the creating, copying, deleting, moving, opening and reading of files diff --git a/src/NovelIO/Helper.fs b/src/NovelIO/Helper.fs index 041dbaf..820b6bd 100644 --- a/src/NovelIO/Helper.fs +++ b/src/NovelIO/Helper.fs @@ -20,33 +20,9 @@ open System.IO module internal InternalIOHelper = /// Helper function to catch IO exceptions and structure the success/failure - let withExceptionCheck f a = + let withExceptionCheck f a : Result<_,_> = try - f a |> IOSuccess + Choice1Of2 <| f a with - | ChannelDoesNotSupportReadingException -> ChannelDoesNotSupportReading |> IOError - | ChannelDoesNotSupportWritingException -> ChannelDoesNotSupportWriting |> IOError - | :? EndOfStreamException as eose -> PastEndOfStream eose |> IOError - | :? System.ObjectDisposedException as ode -> StreamClosed ode |> IOError - | :? FileNotFoundException as fnfe -> FileNotFound fnfe |> IOError - | :? PathTooLongException as ptle -> PathTooLong ptle |> IOError - | :? System.UnauthorizedAccessException as uaex -> UnauthourisedAccess uaex |> IOError - | :? IOException as ioex -> Other ioex |> IOError - - /// Converts a NovelIO file mode to a System.IO.FileMode - let fileModeToSystemIOFileMode (fm : NovelFS.NovelIO.FileMode) = - match fm with - |NovelFS.NovelIO.FileMode.CreateNew -> System.IO.FileMode.CreateNew - |NovelFS.NovelIO.FileMode.Create -> System.IO.FileMode.Create - |NovelFS.NovelIO.FileMode.Open -> System.IO.FileMode.Open - |NovelFS.NovelIO.FileMode.OpenOrCreate -> System.IO.FileMode.OpenOrCreate - |NovelFS.NovelIO.FileMode.Truncate -> System.IO.FileMode.Truncate - |NovelFS.NovelIO.FileMode.Append -> System.IO.FileMode.Append - - /// Converts a NovelIO file mode to a System.IO.FileMode - let fileAccessToSystemIOFileAccess (fa : NovelFS.NovelIO.FileAccess) = - match fa with - |NovelFS.NovelIO.FileAccess.Read -> System.IO.FileAccess.Read - |NovelFS.NovelIO.FileAccess.Write -> System.IO.FileAccess.Write - |NovelFS.NovelIO.FileAccess.ReadWrite -> System.IO.FileAccess.ReadWrite + | exn -> Choice2Of2 exn diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index b9baa73..759c3e2 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -143,9 +143,6 @@ module IO = // ----- GENERAL ----- // - /// An action that writes a line to console - let putStrLn (str : string) = fromEffectful (fun _ -> System.Console.WriteLine str) - /// Allows you to supply an effect which acquires acquires a resource, an effect which releases that research and an action to perform during the resource's lifetime let bracket act fClnUp fBind = io { @@ -202,7 +199,7 @@ module IO = match enmr.MoveNext() with |true -> let! res = mFunc (enmr.Current) - return! iterMRec() + return! iterMRec() //must use return! (not do!) for tail call |false -> return () } iterMRec()) diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index e826735..32b6bc9 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -25,38 +25,8 @@ exception ChannelDoesNotSupportWritingException /// Exception that occurs when attempt to read from a Channel that does not support reading exception ChannelDoesNotSupportReadingException -/// Represents the result of an IO operation -type IOResult<'a> = - /// A successful IO operation - |IOSuccess of 'a - /// An IO operation which failed - |IOError of IOErrorResult -/// A set of possible failure modes for IO Operations -and IOErrorResult = - /// A generic IO failure - |Other of IOException - /// IO failure due to a directory not being found - |DirectoryNotFound of DirectoryNotFoundException - /// IO failure due to a drive not being found - |DriveNotFound of DriveNotFoundException - /// IO failure due to a file not being found - |FileNotFound of FileNotFoundException - /// IO failure due to a path being too long - |PathTooLong of PathTooLongException - /// IO failure due to unathourised access to a resource - |UnauthourisedAccess of System.UnauthorizedAccessException - /// IO failure due a stream being closed - |StreamClosed of System.ObjectDisposedException - /// IO failure due to the supplied channel not supporting reading - |ChannelDoesNotSupportReading - /// IO failure due to the supplied channel not supporting writing - |ChannelDoesNotSupportWriting - /// IO failure due to trying to read past the end of the stream - |PastEndOfStream of EndOfStreamException - /// Incorrect format - |IncorrectFormat - /// IO failure due to an action being attempted on a stream which does not support it - |StreamStateUnsupported of string +/// Result type which represents success or failure +type Result<'T,'E when 'E :> exn> = Choice<'T,'E> /// Units of bytes [] type Bytes @@ -90,6 +60,11 @@ module PathDiscriminators = |Some fname -> ValidFilePath fname |None -> InvalidFilePath + let (|Ok|Error|) result = + match result with + |Choice1Of2 result -> Ok result + |Choice2Of2 err -> Error err + /// General functions of wide applicability [] module General = From b0572d2b8469b2cf43422c911bc622f70dfe3dd6 Mon Sep 17 00:00:00 2001 From: Phil Date: Sat, 3 Sep 2016 13:05:58 +0100 Subject: [PATCH 17/20] Removed runGuarded function --- src/NovelIO/IO.fs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 759c3e2..dc14626 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -154,11 +154,6 @@ module IO = ignore << run <| fClnUp a) } - /// Runs the IO actions and evaluates the result, handling success or failure using IOResult - let runGuarded io = - // run recursively and channel exceptions in IO - InternalIOHelper.withExceptionCheck (run) io - /// Allows a supplied IO action to be executed on the thread pool, returning a task from which you can /// observe the result let forkTask<'a> (io : IO<'a>) = From 1e57c8fc43a2ab84feab280727a0b272edb7f9e8 Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 4 Sep 2016 12:11:46 +0100 Subject: [PATCH 18/20] Improvements to the introduction documentation --- docs/content/index.fsx | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/docs/content/index.fsx b/docs/content/index.fsx index 61f6e98..2d7f781 100644 --- a/docs/content/index.fsx +++ b/docs/content/index.fsx @@ -11,7 +11,9 @@ let someAction = IO.return' () Introduction ====================== -NovelIO is a library designed to bring the explicit safety and robustness of Haskell's IO monad to the .NET framework. The result is a purely functional approach to describing I/O operations whereby the application of functions does not perform side-effecting computations but rather constructs a data type representing a sequence of actions that can later be executed. +NovelIO is a library designed to bring the explicit safety and robustness that comes with describing effects in the type system to the .NET framework. The result is a purely functional approach to describing I/O operations whereby functions do not perform side-effects but rather construct values that represent a sequence of effects that can later be executed. + +The primary goal of this library is to help developers to design more maintainable and testable code by making it easier to reason about when I/O operations occur. Much like in Haskell, we introduce the `IO<'a>` type which represents some action that, when performed successfully, returns some result `'a.` Here are some examples: @@ -25,9 +27,11 @@ The IO action can equally represent an arbitrary sequence of actions: * An IO action that requests a Name, then that person's Date of Birth from a service might have type `IO` * An IO action that returns a potentially unknown number of lines from a file might have type `IO` -Indeed an entire web server could be represented as a single value of type `IO`. +Indeed an entire web server could be represented as a single value of type `IO`! + +The key distinction between this representation of effects and the side-effects found in imperative programming is that values of type `IO<'a>` do not represent the result of some side effect, they actually represent the action/effect that can be `run` to produce a particular result. -Values of type `IO<'a>` are distinct from traditional values in that they do not represent the result of some side effect, they rather represent an action (or sequence of actions) that can be `run` to produce a particular result. +The idea of actions being values rather than functions is extremely powerful, it allows us to begin with a small set of orthogonal primitive actions that can be passed around and composed, using combinator functions, to build up to advanced behaviours quickly, easily and safely! ## Running IO Actions From a4bd71dc69353cca73151378dc51ee8220dbdc6b Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 4 Sep 2016 12:41:42 +0100 Subject: [PATCH 19/20] Further updates to introduction around parallel io --- docs/content/index.fsx | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/docs/content/index.fsx b/docs/content/index.fsx index 2d7f781..104e7ec 100644 --- a/docs/content/index.fsx +++ b/docs/content/index.fsx @@ -11,7 +11,8 @@ let someAction = IO.return' () Introduction ====================== -NovelIO is a library designed to bring the explicit safety and robustness that comes with describing effects in the type system to the .NET framework. The result is a purely functional approach to describing I/O operations whereby functions do not perform side-effects but rather construct values that represent a sequence of effects that can later be executed. +NovelIO is a library designed to bring the explicit safety and robustness that comes with describing effects in the type system to the .NET framework. +The result is a purely functional approach to describing I/O operations whereby functions do not perform side-effects but rather construct values that represent a sequence of effects that can later be executed. The primary goal of this library is to help developers to design more maintainable and testable code by making it easier to reason about when I/O operations occur. @@ -178,15 +179,20 @@ io { ### Parallel actions -Entire lists of IO actions can be performed in parallel using the `IO.parallel` combinators. This gives us very explicit, fine-grained, control over what actions should take place in parallel. +Entire lists of IO actions can be performed in parallel using the functions in the `IO.Parallel` module. This gives us very explicit, fine-grained, control over what actions should take place in parallel. -In order to execute items in parallel, we can simply build a list of the IO actions we wish to perform and use the `par` combinator. For example: +In order to execute items in parallel, we can simply build a list of the IO actions we wish to perform and use the `IO.Parallel.sequence` combinator. + +> **Aside:** You may notice that `IO.Parallel.sequence` has exactly the same type signature as the `IO.sequence` function. +These two functions are fundamentally very similar, the only difference is that `IO.sequence` joins a list of actions sequentially and `IO.Parallel.sequence` joins a list of actions in parallel. + +For example: *) io { let fName = File.Path.fromValid "file.txt" let! channel = File.openTextChannel File.Open.defaultRead fName - return IO.Parallel.par [Console.readLine; TextChannel.getLine channel] + return IO.Parallel.sequence [Console.readLine; TextChannel.getLine channel] } |> IO.run (** From 9fd5acc5cc87d05ac7630e7e6508ced94ea15449 Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 4 Sep 2016 23:44:31 +0100 Subject: [PATCH 20/20] Updated release notes --- RELEASE_NOTES.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 404ef25..855279d 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,10 @@ +#### 0.4.0-alpha - 04/09/2016 +API improvements, particularly centred around simplifying common tasks +Added support for asynchronous IO within the IO type +Added support for forking and awaiting TPL tasks +Many performance optimisations +Documentation massively improved + #### 0.3.0-alpha - 12/07/2016 Added support for recursive PUs Renamed Handles to Channels - part of wider API improvements