From 7a2846a2a8da03732f76e5659f1cac011b48a82c Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Thu, 23 Jun 2016 23:07:40 +0100 Subject: [PATCH 01/13] alt combinator now takes supplied endianness Option pickler is now endian sensitive Fixed big endian pickler primitives Added endian pickler primitive tests --- src/NovelIO/BinaryPickler.fs | 19 ++++-- src/NovelIO/PicklerInfrastructure.fs | 22 +++--- tests/NovelIO.UnitTests/BinaryTests.fs | 68 +++++++++++++++++++ tests/NovelIO.UnitTests/CombinatorTests.fs | 28 +++++++- tests/NovelIO.UnitTests/Endian.fs | 9 +++ .../NovelIO.UnitTests.fsproj | 1 + 6 files changed, 130 insertions(+), 17 deletions(-) create mode 100644 tests/NovelIO.UnitTests/Endian.fs diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index cfbaca7..ce4a149 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -219,7 +219,7 @@ module BinaryPickler = /// Accepts a tagging function that partitions the type to be pickled/unpickled into two sets, then accepts a PU for each set. This permits /// creating PUs that might pickle one of several alternatives - let alt tag ps = sequ tag intPU (flip Map.find <| ps) + let altE endianness tag ps = sequ tag (int32PUE endianness) (flip Map.find <| ps) /// A pickler/unpickler pair (PU) for lists which prefixes the length using the Endianness of the current platform let list pa = sequ (List.length) intPU << repeat <| pa @@ -240,13 +240,16 @@ module BinaryPickler = let pNullTerm = repeatUntil ((=) '\000') pa pNullTerm |> wrap (Array.ofList >> System.String, List.ofSeq) - /// A pickler/unpickler pair (PU) for option types - let optionPU pa = + /// A pickler/unpickler pair (PU) for option types in the supplied endianness + let private optionalPUE endianness pa = let tag = function |Some _ -> 1 |None -> 0 let map = Map.ofList [(0, lift None); (1, wrap (Some, Option.get) pa)] - alt tag map + altE endianness tag map + + /// A pickler/unpickler pair (PU) for option types in the Endianness of the current platform + let optional pa = optionalPUE (ByteOrder.systemEndianness) pa /// A pickler/unpickler pair (PU) for ASCII chars let asciiCharPU = @@ -299,7 +302,7 @@ module BinaryPickler = let float32PU = float32PUE LittleEndian /// A pickler/unpickler pair (PU) for floats in Little Endian byte order - let floatLittleEPU = floatPUE LittleEndian + let floatPU = floatPUE LittleEndian /// A pickler/unpickler pair (PU) for decimals in Little Endian byte order let decimalLittleEPU = decimalPUE LittleEndian @@ -319,6 +322,9 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in Little Endian byte order let byteLengthPrefixed pu = byteLengthPrefixE LittleEndian pu + /// A pickler/unpickler pair (PU) for option types in the Endianness in Little Endian byte order + let optional pa = optionalPUE LittleEndian pa + /// Primitive and combinator Pickler/Unpickler pairs that use Big Endian byte order module BigEndian = /// A pickler/unpickler pair (PU) for int16s in Big Endian byte order @@ -354,6 +360,9 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in Big Endian byte order let byteLengthPrefixed pu = byteLengthPrefixE BigEndian pu + /// A pickler/unpickler pair (PU) for option types in the Endianness in Big Endian byte order + let optional pa = optionalPUE BigEndian pa + /// A pickler/unpickler pair (PU) for UTF-16 strings which uses a byte order mark to indicate endianness when unpickling. During pickling, little endian is used and a byte order /// mark to indicate this is prepended. let utf16PU = pickleUTFXWithEndiannessDetect (Encoding.UTF16 {Endianness = LittleEndian; ByteOrderMark = true}) LittleEndian.utf16PU BigEndian.utf16PU diff --git a/src/NovelIO/PicklerInfrastructure.fs b/src/NovelIO/PicklerInfrastructure.fs index 6c9eefc..d604a67 100644 --- a/src/NovelIO/PicklerInfrastructure.fs +++ b/src/NovelIO/PicklerInfrastructure.fs @@ -49,6 +49,8 @@ module internal PickleConvertors = |true, BigEndian |false, LittleEndian -> Array.rev arr |_ -> arr + let inline arrSub start count arr = Array.sub arr start count + /// Convert a chunk of a byte array into an bool with exception checking let convToBool pos array = let unchecked pos arr = System.BitConverter.ToBoolean(arr, pos) @@ -56,28 +58,28 @@ module internal PickleConvertors = /// Convert a chunk of a byte array into an int16 with exception checking let convToInt16 endianness pos array = - let unchecked pos arr = System.BitConverter.ToInt16(arr, pos) - checkConversionException (unchecked pos << flipForEndianness endianness) pos array + let unchecked pos arr = System.BitConverter.ToInt16(flipForEndianness endianness (arrSub pos sizeof arr), 0) + checkConversionException (unchecked pos) pos array /// Convert a chunk of a byte array into an int32 with exception checking let convToInt32 endianness pos array = - let unchecked pos arr = System.BitConverter.ToInt32(arr, pos) - checkConversionException (unchecked pos << flipForEndianness endianness) pos array + let unchecked pos arr = System.BitConverter.ToInt32(flipForEndianness endianness (arrSub pos sizeof arr), 0) + checkConversionException (unchecked pos) pos array /// Convert a chunk of a byte array into an int64 with exception checking let convToInt64 endianness pos array = - let unchecked pos arr = System.BitConverter.ToInt64(arr, pos) - checkConversionException (unchecked pos << flipForEndianness endianness) pos array + let unchecked pos arr = System.BitConverter.ToInt64(flipForEndianness endianness (arrSub pos sizeof arr), 0) + checkConversionException (unchecked pos) pos array /// Convert a chunk of a byte array into an float32 with exception checking let convToFloat32 endianness pos array = - let unchecked pos arr = System.BitConverter.ToSingle(arr, pos) - checkConversionException (unchecked pos << flipForEndianness endianness) pos array + let unchecked pos arr = System.BitConverter.ToSingle(flipForEndianness endianness (arrSub pos sizeof arr), 0) + checkConversionException (unchecked pos) pos array /// Convert a chunk of a byte array into an float64 with exception checking let convToFloat64 endianness pos array = - let unchecked pos arr = System.BitConverter.ToDouble(arr, pos) - checkConversionException (unchecked pos << flipForEndianness endianness) pos array + let unchecked pos arr = System.BitConverter.ToDouble(flipForEndianness endianness (arrSub pos sizeof arr), 0) + checkConversionException (unchecked pos) pos array /// Flips an array to produce a list in the opposite order let arrayFlipToList a = Array.fold(fun lst it -> it :: lst) [] a diff --git a/tests/NovelIO.UnitTests/BinaryTests.fs b/tests/NovelIO.UnitTests/BinaryTests.fs index ec1ad59..31ccc52 100644 --- a/tests/NovelIO.UnitTests/BinaryTests.fs +++ b/tests/NovelIO.UnitTests/BinaryTests.fs @@ -36,6 +36,18 @@ type ``Binary Pickler Tests`` = let result = BinaryPickler.unpickle int16Pickler bytes result = i16 + [] + static member ``Unpickle int16 (little endian) from array of bytes`` (i16 : int16) = + let bytes = EndianHelper.convertToEndianness LittleEndian <| System.BitConverter.GetBytes i16 + let result = BinaryPickler.unpickle BinaryPickler.LittleEndian.int16PU bytes + result = i16 + + [] + static member ``Unpickle int16 (big endian) from array of bytes`` (i16 : int16) = + let bytes = EndianHelper.convertToEndianness BigEndian <| System.BitConverter.GetBytes i16 + let result = BinaryPickler.unpickle BinaryPickler.BigEndian.int16PU bytes + result = i16 + [] static member ``Unpickle int from array of bytes`` (i32 : int32) = let bytes = System.BitConverter.GetBytes i32 @@ -43,6 +55,18 @@ type ``Binary Pickler Tests`` = let result = BinaryPickler.unpickle int32Pickler bytes result = i32 + [] + static member ``Unpickle int32 (little endian) from array of bytes`` (i32 : int32) = + let bytes = EndianHelper.convertToEndianness LittleEndian <| System.BitConverter.GetBytes i32 + let result = BinaryPickler.unpickle BinaryPickler.LittleEndian.intPU bytes + result = i32 + + [] + static member ``Unpickle int32 (big endian) from array of bytes`` (i32 : int32) = + let bytes = EndianHelper.convertToEndianness BigEndian <| System.BitConverter.GetBytes i32 + let result = BinaryPickler.unpickle BinaryPickler.BigEndian.intPU bytes + result = i32 + [] static member ``Unpickle int64 from array of bytes`` (i64 : int64) = let bytes = System.BitConverter.GetBytes i64 @@ -50,6 +74,18 @@ type ``Binary Pickler Tests`` = let result = BinaryPickler.unpickle int64Pickler bytes result = i64 + [] + static member ``Unpickle int64 (little endian) from array of bytes`` (i64 : int64) = + let bytes = EndianHelper.convertToEndianness LittleEndian <| System.BitConverter.GetBytes i64 + let result = BinaryPickler.unpickle BinaryPickler.LittleEndian.int64PU bytes + result = i64 + + [] + static member ``Unpickle int64 (big endian) from array of bytes`` (i64 : int64) = + let bytes = EndianHelper.convertToEndianness BigEndian <| System.BitConverter.GetBytes i64 + let result = BinaryPickler.unpickle BinaryPickler.BigEndian.int64PU bytes + result = i64 + [] static member ``Unpickle float64 from array of bytes`` (flt : float) = let bytes = System.BitConverter.GetBytes flt @@ -59,6 +95,22 @@ type ``Binary Pickler Tests`` = |x when System.Double.IsNaN(x) -> System.Double.IsNaN(flt) |_ -> result = flt + [] + static member ``Unpickle float64 (little endian) from array of bytes`` (flt : float) = + let bytes = EndianHelper.convertToEndianness LittleEndian <| System.BitConverter.GetBytes flt + let result = BinaryPickler.unpickle BinaryPickler.LittleEndian.floatPU bytes + match result with + |x when System.Double.IsNaN(x) -> System.Double.IsNaN(flt) + |_ -> result = flt + + [] + static member ``Unpickle float64 (big endian) from array of bytes`` (flt : float) = + let bytes = EndianHelper.convertToEndianness BigEndian <| System.BitConverter.GetBytes flt + let result = BinaryPickler.unpickle BinaryPickler.BigEndian.floatPU bytes + match result with + |x when System.Double.IsNaN(x) -> System.Double.IsNaN(flt) + |_ -> result = flt + [] static member ``Unpickle float32 from array of bytes`` (flt : float32) = let bytes = System.BitConverter.GetBytes flt @@ -68,6 +120,22 @@ type ``Binary Pickler Tests`` = |x when System.Single.IsNaN(x) -> System.Single.IsNaN(flt) |_ -> result = flt + [] + static member ``Unpickle float32 (little endian) from array of bytes`` (flt : float32) = + let bytes = EndianHelper.convertToEndianness LittleEndian <| System.BitConverter.GetBytes flt + let result = BinaryPickler.unpickle BinaryPickler.LittleEndian.float32PU bytes + match result with + |x when System.Single.IsNaN(x) -> System.Single.IsNaN(flt) + |_ -> result = flt + + [] + static member ``Unpickle float32 (big endian) from array of bytes`` (flt : float32) = + let bytes = EndianHelper.convertToEndianness BigEndian <| System.BitConverter.GetBytes flt + let result = BinaryPickler.unpickle BinaryPickler.BigEndian.float32PU bytes + match result with + |x when System.Single.IsNaN(x) -> System.Single.IsNaN(flt) + |_ -> result = flt + [] static member ``Unpickle decimal from array of bytes`` (dec : decimal) = let bytes = diff --git a/tests/NovelIO.UnitTests/CombinatorTests.fs b/tests/NovelIO.UnitTests/CombinatorTests.fs index a7ec4ba..4d836e6 100644 --- a/tests/NovelIO.UnitTests/CombinatorTests.fs +++ b/tests/NovelIO.UnitTests/CombinatorTests.fs @@ -21,7 +21,9 @@ open NovelFS.NovelIO.BinaryPickler open FsCheck open FsCheck.Xunit -type ``Binary Pickler Combinator Tests`` = +type ``Binary Pickler Combinator Tests``() = + + [] static member ``Pickle values until 0 should create zero terminated list`` (lst : int list) = @@ -118,7 +120,29 @@ type ``Binary Pickler Combinator Tests`` = match opt with |Some i -> Array.concat [System.BitConverter.GetBytes 1; System.BitConverter.GetBytes i] |None -> System.BitConverter.GetBytes 0 - let arrPickler = BinaryPickler.optionPU (BinaryPickler.intPU) + let arrPickler = BinaryPickler.optional (BinaryPickler.intPU) + let result = BinaryPickler.unpickle arrPickler bytes + result = opt + + [] + static member ``Unpickle int option (little endian) should match 0 or 1 tagged int`` (opt : int option) = + let convLE arr = EndianHelper.convertToEndianness LittleEndian arr + let bytes = + match opt with + |Some i -> Array.concat [convLE <| System.BitConverter.GetBytes 1; convLE <| System.BitConverter.GetBytes i] + |None -> convLE <| System.BitConverter.GetBytes 0 + let arrPickler = BinaryPickler.LittleEndian.optional (BinaryPickler.LittleEndian.intPU) + let result = BinaryPickler.unpickle arrPickler bytes + result = opt + + [] + static member ``Unpickle int option (big endian) should match 0 or 1 tagged int`` (opt : int option) = + let convBE arr = EndianHelper.convertToEndianness BigEndian arr + let bytes = + match opt with + |Some i -> Array.concat [convBE <| System.BitConverter.GetBytes 1; convBE <| System.BitConverter.GetBytes i] + |None -> convBE <| System.BitConverter.GetBytes 0 + let arrPickler = BinaryPickler.BigEndian.optional (BinaryPickler.BigEndian.intPU) let result = BinaryPickler.unpickle arrPickler bytes result = opt diff --git a/tests/NovelIO.UnitTests/Endian.fs b/tests/NovelIO.UnitTests/Endian.fs new file mode 100644 index 0000000..c362569 --- /dev/null +++ b/tests/NovelIO.UnitTests/Endian.fs @@ -0,0 +1,9 @@ +namespace NovelFS.NovelIO.UnitTests + +open NovelFS.NovelIO + +module EndianHelper = + let convertToEndianness endianness arr = + match endianness, System.BitConverter.IsLittleEndian with + |(LittleEndian, false) | (BigEndian, true) -> Array.rev arr + |_ -> arr \ No newline at end of file diff --git a/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj b/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj index 6d1fa51..8cf9a76 100644 --- a/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj +++ b/tests/NovelIO.UnitTests/NovelIO.UnitTests.fsproj @@ -53,6 +53,7 @@ + From 3b37cce707049ccbae3f3f91f88d580cba5e6b24 Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 26 Jun 2016 22:28:28 +0100 Subject: [PATCH 02/13] Added uint16/32/64 picklers Added byte length prefixes in byte and (u)int16 formats --- src/NovelIO/BinaryPickler.fs | 77 +++++++++++++++++++++++----- src/NovelIO/PicklerInfrastructure.fs | 60 ++++++++++++---------- 2 files changed, 98 insertions(+), 39 deletions(-) diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index ce4a149..5f70571 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -155,6 +155,13 @@ module BinaryPickler = Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt16 endianness) st } + /// A pickler/unpickler pair (PU) for uint16s of the supplied endianness + let private uint16PUE endianness = + { + Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromUInt16 endianness) i16 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt16 endianness) st + } + /// A pickler/unpickler pair (PU) for int32s of the supplied endianness let private int32PUE endianness = { @@ -162,6 +169,13 @@ module BinaryPickler = Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt32 endianness) st } + /// A pickler/unpickler pair (PU) for uint32s of the supplied endianness + let private uint32PUE endianness = + { + Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromUInt32 endianness) i32 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt32 endianness) st + } + /// A pickler/unpickler pair (PU) for int64s of the supplied endianness let private int64PUE endianness = { @@ -169,6 +183,13 @@ module BinaryPickler = Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt64 endianness) st } + /// A pickler/unpickler pair (PU) for uint64s of the supplied endianness + let private uint64PUE endianness = + { + Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromUInt64 endianness) i64 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt64 endianness) st + } + /// A pickler/unpickler pair (PU) for float32s of the supplied endianness let private float32PUE endianness = { @@ -188,26 +209,49 @@ module BinaryPickler = let intAToDecimal (a : int[]) = System.Decimal a wrap (intAToDecimal, System.Decimal.GetBits) (repeatA (int32PUE endianness) 4) - /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in the supplied endianness - let private byteLengthPrefixE endianness pu = + let private byteLengthPrefixE fPickle fConv endianness pu = { Pickle = fun (v, s) -> pickleHelper (fun v' -> let arr = pickle pu v' - let byteLen = PickleConvertors.convFromInt32 endianness (Array.length arr) + let byteLen = fPickle endianness (fConv <| Array.length arr) Array.concat [byteLen; arr]) v s Unpickle = fun st -> unpickleHelper (fun _ b -> unpickle pu (Array.skip 4 b)) st } - /// A pickler/unpickler pair (PU) for int16s in the Endianness of the current platform + /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure as a (signed) int in the supplied endianness + let private intByteLengthPrefixE endianness pu = byteLengthPrefixE PickleConvertors.convFromInt32 id endianness pu + + /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure as an (unsigned) uint in the supplied endianness + let private uintByteLengthPrefixE endianness pu = byteLengthPrefixE PickleConvertors.convFromUInt32 uint32 endianness pu + + /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure as a (signed) int16 in the supplied endianness + let private int16ByteLengthPrefixE endianness pu = byteLengthPrefixE PickleConvertors.convFromInt16 int16 endianness pu + + /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure as an (unsigned) uint16 in the supplied endianness + let private uint16ByteLengthPrefixE endianness pu = byteLengthPrefixE PickleConvertors.convFromUInt16 uint16 endianness pu + + /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure as am (unsigned) byte in the supplied endianness + let private byteByteLengthPrefixE endianness pu = byteLengthPrefixE (fun _ -> Array.singleton) byte endianness pu + + /// A pickler/unpickler pair (PU) for (signed) int16s in the Endianness of the current platform let int16PU = int16PUE (ByteOrder.systemEndianness) - /// A pickler/unpickler pair (PU) for ints in the Endianness of the current platform + /// A pickler/unpickler pair (PU) for (unsigned) uint16s in the Endianness of the current platform + let uint16PU = uint16PUE (ByteOrder.systemEndianness) + + /// A pickler/unpickler pair (PU) for (signed) ints in the Endianness of the current platform let intPU = int32PUE (ByteOrder.systemEndianness) - /// A pickler/unpickler pair (PU) for int64s in the Endianness of the current platform + /// A pickler/unpickler pair (PU) for (unsigned) uints in the Endianness of the current platform + let uintPU = uint32PUE (ByteOrder.systemEndianness) + + /// A pickler/unpickler pair (PU) for (signed) int64s in the Endianness of the current platform let int64PU = int64PUE (ByteOrder.systemEndianness) + /// A pickler/unpickler pair (PU) for (unsigned) uint64s in the Endianness of the current platform + let uint64PU = uint64PUE (ByteOrder.systemEndianness) + /// A pickler/unpickler pair (PU) for float32s in the Endianness of the current platform let float32PU = float32PUE (ByteOrder.systemEndianness) @@ -228,7 +272,7 @@ module BinaryPickler = let array pa = sequ (Array.length) intPU << repeatA <| pa /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure using the Endianness of the current platform - let byteLengthPrefixed pu = byteLengthPrefixE (ByteOrder.systemEndianness) pu + let byteLengthPrefixed pu = intByteLengthPrefixE (ByteOrder.systemEndianness) pu /// A pickler/unpickler pair (PU) for creating length prefixed strings from a char PU. The length is prefixed in the Endianness of the current platform let lengthPrefixed (pa : BinaryPU) : BinaryPU = @@ -289,15 +333,24 @@ module BinaryPickler = /// Primitive and combinator Pickler/Unpickler pairs that use Little Endian byte order module LittleEndian = - /// A pickler/unpickler pair (PU) for int16s in Little Endian byte order + /// A pickler/unpickler pair (PU) for (signed) int16s in Little Endian byte order let int16PU = int16PUE LittleEndian + + /// A pickler/unpickler pair (PU) for (unsigned) uint16s in Little Endian byte order + let uint16PU = uint16PUE LittleEndian - /// A pickler/unpickler pair (PU) for ints in Little Endian byte order + /// A pickler/unpickler pair (PU) for (signed) ints in Little Endian byte order let intPU = int32PUE LittleEndian - /// A pickler/unpickler pair (PU) for int64s in Little Endian byte order + /// A pickler/unpickler pair (PU) for (unsigned) uint32s in Little Endian byte order + let uintPU = uint32PUE LittleEndian + + /// A pickler/unpickler pair (PU) for (signed) int64s in Little Endian byte order let int64PU = int64PUE LittleEndian + /// A pickler/unpickler pair (PU) for (unsigned) uint64s in Little Endian byte order + let uint64PU = uint64PUE LittleEndian + /// A pickler/unpickler pair (PU) for float32s in Little Endian byte order let float32PU = float32PUE LittleEndian @@ -320,7 +373,7 @@ module BinaryPickler = let array pa = sequ (Array.length) intPU << repeatA <| pa /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in Little Endian byte order - let byteLengthPrefixed pu = byteLengthPrefixE LittleEndian pu + let byteLengthPrefixed pu = intByteLengthPrefixE LittleEndian pu /// A pickler/unpickler pair (PU) for option types in the Endianness in Little Endian byte order let optional pa = optionalPUE LittleEndian pa @@ -358,7 +411,7 @@ module BinaryPickler = let array pa = sequ (Array.length) intPU << repeatA <| pa /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in Big Endian byte order - let byteLengthPrefixed pu = byteLengthPrefixE BigEndian pu + let byteLengthPrefixed pu = intByteLengthPrefixE BigEndian pu /// A pickler/unpickler pair (PU) for option types in the Endianness in Big Endian byte order let optional pa = optionalPUE BigEndian pa diff --git a/src/NovelIO/PicklerInfrastructure.fs b/src/NovelIO/PicklerInfrastructure.fs index d604a67..2a9889f 100644 --- a/src/NovelIO/PicklerInfrastructure.fs +++ b/src/NovelIO/PicklerInfrastructure.fs @@ -56,57 +56,63 @@ module internal PickleConvertors = let unchecked pos arr = System.BitConverter.ToBoolean(arr, pos) checkConversionException (unchecked pos) pos array - /// Convert a chunk of a byte array into an int16 with exception checking - let convToInt16 endianness pos array = - let unchecked pos arr = System.BitConverter.ToInt16(flipForEndianness endianness (arrSub pos sizeof arr), 0) + let inline convTo f endianness pos (array : byte[]) : 'a = + let unchecked pos arr = f(flipForEndianness endianness (arrSub pos sizeof<'a> arr), 0) checkConversionException (unchecked pos) pos array + /// Convert a chunk of a byte array into an int16 with exception checking + let convToInt16 endianness pos array = convTo (System.BitConverter.ToInt16) endianness pos array + + /// Convert a chunk of a byte array into an uint16 with exception checking + let convToUInt16 endianness pos array = convTo (System.BitConverter.ToUInt16) endianness pos array + /// Convert a chunk of a byte array into an int32 with exception checking - let convToInt32 endianness pos array = - let unchecked pos arr = System.BitConverter.ToInt32(flipForEndianness endianness (arrSub pos sizeof arr), 0) - checkConversionException (unchecked pos) pos array + let convToInt32 endianness pos array = convTo (System.BitConverter.ToInt32) endianness pos array + + /// Convert a chunk of a byte array into an uint32 with exception checking + let convToUInt32 endianness pos array = convTo (System.BitConverter.ToUInt32) endianness pos array /// Convert a chunk of a byte array into an int64 with exception checking - let convToInt64 endianness pos array = - let unchecked pos arr = System.BitConverter.ToInt64(flipForEndianness endianness (arrSub pos sizeof arr), 0) - checkConversionException (unchecked pos) pos array + let convToInt64 endianness pos array = convTo (System.BitConverter.ToInt64) endianness pos array + + /// Convert a chunk of a byte array into an uint64 with exception checking + let convToUInt64 endianness pos array = convTo (System.BitConverter.ToUInt64) endianness pos array /// Convert a chunk of a byte array into an float32 with exception checking - let convToFloat32 endianness pos array = - let unchecked pos arr = System.BitConverter.ToSingle(flipForEndianness endianness (arrSub pos sizeof arr), 0) - checkConversionException (unchecked pos) pos array + let convToFloat32 endianness pos array = convTo (System.BitConverter.ToSingle) endianness pos array /// Convert a chunk of a byte array into an float64 with exception checking - let convToFloat64 endianness pos array = - let unchecked pos arr = System.BitConverter.ToDouble(flipForEndianness endianness (arrSub pos sizeof arr), 0) - checkConversionException (unchecked pos) pos array + let convToFloat64 endianness pos array = convTo (System.BitConverter.ToDouble) endianness pos array /// Flips an array to produce a list in the opposite order let arrayFlipToList a = Array.fold(fun lst it -> it :: lst) [] a /// Converts a bool to a byte list in reverse order - let convFromBool (b : bool) = - System.BitConverter.GetBytes b + let convFromBool (b : bool) = System.BitConverter.GetBytes b /// Converts an int16 to a byte list in reverse order - let convFromInt16 endianness (i16 : int16) = - flipForEndianness endianness <| System.BitConverter.GetBytes i16 + let convFromInt16 endianness (i16 : int16) = flipForEndianness endianness <| System.BitConverter.GetBytes i16 + + /// Converts an uint16 to a byte list in reverse order + let convFromUInt16 endianness (i16 : uint16) = flipForEndianness endianness <| System.BitConverter.GetBytes i16 /// Converts an int32 to a byte list in reverse order - let convFromInt32 endianness (i32 : int32) = - flipForEndianness endianness <| System.BitConverter.GetBytes i32 + let convFromInt32 endianness (i32 : int32) = flipForEndianness endianness <| System.BitConverter.GetBytes i32 + + /// Converts an uint32 to a byte list in reverse order + let convFromUInt32 endianness (i32 : uint32) = flipForEndianness endianness <| System.BitConverter.GetBytes i32 /// Converts an int64 to a byte list in reverse order - let convFromInt64 endianness (i64 : int64) = - flipForEndianness endianness <| System.BitConverter.GetBytes i64 + let convFromInt64 endianness (i64 : int64) = flipForEndianness endianness <| System.BitConverter.GetBytes i64 + + /// Converts an uint64 to a byte list in reverse order + let convFromUInt64 endianness (i64 : uint64) = flipForEndianness endianness <| System.BitConverter.GetBytes i64 /// Converts an float32 to a byte list in reverse order - let convFromFloat32 endianness (f32 : float32) = - flipForEndianness endianness <| System.BitConverter.GetBytes f32 + let convFromFloat32 endianness (f32 : float32) = flipForEndianness endianness <| System.BitConverter.GetBytes f32 /// Converts an float64 to a byte list in reverse order - let convFromFloat64 endianness (f64 : float) = - flipForEndianness endianness <| System.BitConverter.GetBytes f64 + let convFromFloat64 endianness (f64 : float) = flipForEndianness endianness <| System.BitConverter.GetBytes f64 /// Encoding conversion functions module Encodings = From 8704c296099a066053af3953fe7c7d71609643f9 Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Thu, 30 Jun 2016 19:43:45 +0100 Subject: [PATCH 03/13] Experimenting with eager and lazy PUs Changed PU definition to be either eager or lazy Made runPickle/unPickle functions recursive. The lazy versions recurse until they're no longer lazy The sequ function is recusive and also recurses until the lazyness is gone All the primitive PUs become Eager --- src/NovelIO/BinaryPickler.fs | 147 ++++++++++++++++++++--------------- 1 file changed, 85 insertions(+), 62 deletions(-) diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index 5f70571..5633e4c 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -18,18 +18,26 @@ namespace NovelFS.NovelIO.BinaryPickler open NovelFS.NovelIO +type EagerBinaryPU<'a> = private {Pickle : 'a * BPickleState -> BPickleState; Unpickle : BUnpickleState -> 'a * BUnpickleState} + /// A pickler/unpickler pair for type 'a -type BinaryPU<'a> = private {Pickle : 'a * BPickleState -> BPickleState; Unpickle : BUnpickleState -> 'a * BUnpickleState} +type BinaryPU<'a> = + |EagerPU of EagerBinaryPU<'a> + |LazyPU of (unit -> BinaryPU<'a>) + /// Provides functions for pickling binary data module BinaryPickler = - let private runUnpickle state x = + let rec private runUnpickle state x = match x with - |{Unpickle = g; Pickle = _} -> g state + |EagerPU{Unpickle = g; Pickle = _} -> g state + |LazyPU y -> runUnpickle state (y()) - let private runPickle (a, st) x = + let rec private runPickle (a, st) x = match x with - |{Unpickle = _; Pickle = g} -> g (a, st) + |EagerPU{Unpickle = _; Pickle = g} -> g (a, st) + |LazyPU y -> runPickle (a,st) (y()) + /// Uses the supplied pickler/unpickler pair (PU) to unpickle the supplied byte array into some type 'a let unpickle pu array = @@ -66,13 +74,13 @@ module BinaryPickler = /// Given a value of x, returns a PU of x without affecting the underlying read/write states - let lift x = {Pickle = (fun (_,st) -> st); Unpickle = (fun s -> x, s)} + let lift x = EagerPU{Pickle = (fun (_,st) -> st); Unpickle = (fun s -> x, s)} /// Creates a sequential combination of PU - let sequ (f : 'b -> 'a) (pa : BinaryPU<'a>) (k : 'a -> BinaryPU<'b>) : BinaryPU<'b> = + let rec sequ (f : 'b -> 'a) (pa : BinaryPU<'a>) (k : 'a -> BinaryPU<'b>) : BinaryPU<'b> = match pa with - |{Unpickle = unPck; Pickle = pck} -> - // unpickling is sequenced like bind in the reader monad + |EagerPU{Unpickle = unPck; Pickle = pck} -> + // unpickling is sequenced like bind in the state monad let unPck' s = let a, s' = runUnpickle s pa runUnpickle s' (k a) @@ -81,7 +89,10 @@ module BinaryPickler = let a = f b let pb = k a runPickle (b, runPickle (a, s) pa) pb - {Unpickle = unPck'; Pickle = pck'} + EagerPU{Unpickle = unPck'; Pickle = pck'} + |LazyPU y -> + let lazySequ = fun () -> sequ f (y()) k + LazyPU lazySequ /// Combines two PU into a PU that pickles a tuple-2 let tuple2 pa pb = @@ -136,73 +147,83 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for bools let boolPU = - { - Pickle = fun (b, s) -> pickleHelper (PickleConvertors.convFromBool) b s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToBool) st - } + EagerPU + { + Pickle = fun (b, s) -> pickleHelper (PickleConvertors.convFromBool) b s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToBool) st + } /// A pickler/unpickler pair (PU) for bytes let bytePU = - { - Pickle = fun (b, s) -> pickleHelper (Array.singleton) b s - Unpickle = fun st -> unpickleHelper (Array.item) st - } + EagerPU + { + Pickle = fun (b, s) -> pickleHelper (Array.singleton) b s + Unpickle = fun st -> unpickleHelper (Array.item) st + } /// A pickler/unpickler pair (PU) for int16s of the supplied endianness let private int16PUE endianness = - { - Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromInt16 endianness) i16 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt16 endianness) st - } + EagerPU + { + Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromInt16 endianness) i16 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt16 endianness) st + } /// A pickler/unpickler pair (PU) for uint16s of the supplied endianness let private uint16PUE endianness = - { - Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromUInt16 endianness) i16 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt16 endianness) st - } + EagerPU + { + Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromUInt16 endianness) i16 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt16 endianness) st + } /// A pickler/unpickler pair (PU) for int32s of the supplied endianness let private int32PUE endianness = - { - Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromInt32 endianness) i32 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt32 endianness) st - } + EagerPU + { + Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromInt32 endianness) i32 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt32 endianness) st + } /// A pickler/unpickler pair (PU) for uint32s of the supplied endianness let private uint32PUE endianness = - { - Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromUInt32 endianness) i32 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt32 endianness) st - } + EagerPU + { + Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromUInt32 endianness) i32 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt32 endianness) st + } /// A pickler/unpickler pair (PU) for int64s of the supplied endianness let private int64PUE endianness = - { - Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromInt64 endianness) i64 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt64 endianness) st - } + EagerPU + { + Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromInt64 endianness) i64 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt64 endianness) st + } /// A pickler/unpickler pair (PU) for uint64s of the supplied endianness let private uint64PUE endianness = - { - Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromUInt64 endianness) i64 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt64 endianness) st - } + EagerPU + { + Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromUInt64 endianness) i64 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt64 endianness) st + } /// A pickler/unpickler pair (PU) for float32s of the supplied endianness let private float32PUE endianness = - { - Pickle = fun (f32, s) -> pickleHelper (PickleConvertors.convFromFloat32 endianness) f32 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat32 endianness) st - } + EagerPU + { + Pickle = fun (f32, s) -> pickleHelper (PickleConvertors.convFromFloat32 endianness) f32 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat32 endianness) st + } /// A pickler/unpickler pair (PU) for floats of the supplied endianness let private floatPUE endianness = - { - Pickle = fun (f64, s) -> pickleHelper (PickleConvertors.convFromFloat64 endianness) f64 s - Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat64 endianness) st - } + EagerPU + { + Pickle = fun (f64, s) -> pickleHelper (PickleConvertors.convFromFloat64 endianness) f64 s + Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat64 endianness) st + } /// A pickler/unpickler pair (PU) for decimals of the supplied endianness let private decimalPUE endianness = @@ -210,14 +231,15 @@ module BinaryPickler = wrap (intAToDecimal, System.Decimal.GetBits) (repeatA (int32PUE endianness) 4) let private byteLengthPrefixE fPickle fConv endianness pu = - { - Pickle = fun (v, s) -> - pickleHelper (fun v' -> - let arr = pickle pu v' - let byteLen = fPickle endianness (fConv <| Array.length arr) - Array.concat [byteLen; arr]) v s - Unpickle = fun st -> unpickleHelper (fun _ b -> unpickle pu (Array.skip 4 b)) st - } + EagerPU + { + Pickle = fun (v, s) -> + pickleHelper (fun v' -> + let arr = pickle pu v' + let byteLen = fPickle endianness (fConv <| Array.length arr) + Array.concat [byteLen; arr]) v s + Unpickle = fun st -> unpickleHelper (fun _ b -> unpickle pu (Array.skip 4 b)) st + } /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure as a (signed) int in the supplied endianness let private intByteLengthPrefixE endianness pu = byteLengthPrefixE PickleConvertors.convFromInt32 id endianness pu @@ -310,10 +332,11 @@ module BinaryPickler = /// Creates a pickler/unpickler pair (PU) for strings using the supplied encoding let encodingPU encoding = let pickleEncodingS byteCount = - { - Pickle = fun (str, s) -> pickleHelper (PickleConvertors.Encodings.convFromEncoding encoding) str s - Unpickle = fun st -> unpickleHelperSized byteCount (PickleConvertors.Encodings.convToEncoding encoding byteCount) st - } + EagerPU + { + Pickle = fun (str, s) -> pickleHelper (PickleConvertors.Encodings.convFromEncoding encoding) str s + Unpickle = fun st -> unpickleHelperSized byteCount (PickleConvertors.Encodings.convToEncoding encoding byteCount) st + } sequ (Encoding.byteLength encoding) intPU pickleEncodingS /// A pickler/unpickler pair (PU) for UTF-8 strings From fc81aa9a628ff6d59009f56791c9bf1daccf4635 Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Sat, 2 Jul 2016 11:26:03 +0100 Subject: [PATCH 04/13] Renamed Eager/LazyPU to Final/RecursivePU Added a PU for unit types Made altE combinator provided and added alt combinators for each endianness Updated docs with info about using alt/DU tagging Other docs tweaks --- docs/content/motivation.fsx | 35 +++++++++++++----- docs/content/pickler.fsx | 23 ++++++++++++ src/NovelIO/BinaryPickler.fs | 71 ++++++++++++++++++++++-------------- 3 files changed, 91 insertions(+), 38 deletions(-) diff --git a/docs/content/motivation.fsx b/docs/content/motivation.fsx index 177afba..9d751e2 100644 --- a/docs/content/motivation.fsx +++ b/docs/content/motivation.fsx @@ -118,7 +118,7 @@ At first glance, this program might appear to record key strokes until the user In reality, this program counts key strokes until the user presses 'Enter' and prints this length, then it records key strokes again until the user presses 'Enter' and prints the result. -If we express this program using this library, the side effects are clearly apparent: +If we express this program using this library, the effects are clearly apparent: *) @@ -166,7 +166,7 @@ Consider this code: *) -let randomSeq = Seq.init 20 (fun _ -> rnd.Next()) +let randomSeq = Seq.init 4 (fun _ -> rnd.Next()) let sortedSeq = Seq.sort randomSeq printfn "Sorted: %A" sortedSeq @@ -174,37 +174,52 @@ printfn "Random: %A" randomSeq (** -Indeed, the numbers shown in the 'Sorted' and 'Random' lists could be totally different. Each time we enumerate **randomSeq**, the side effect of getting the next random number is produced again! +Let's at the results of an example run of this program: -Here is the same program written using NovelIO. Notice that we have to explicitly ask for a second sequence. +> Sorted: seq [42595606; 980900814; 1328311795; 1497661916] +> Random: seq [308839936; 1514073672; 36105878; 741971034] + +While this program appears to generate one sequence, sort it, then print the sorted and unsorted result - that isn't what it actually does. What it actually does is effectively define two random sequence generators, one of which is sorted and the other is not. + +Each time we enumerate `randomSeq` or `sortedSeq`, the original side effect of getting random numbers is produced again and again! + +Here is the original program we desired to write using NovelIO. *) io { - let randomSeqIO = IO.replicateM (Random.nextIO) 20 + let randomSeqIO = IO.replicateM (Random.nextIO) 4 let! randomSeq = randomSeqIO - let! randomSeq2 = randomSeqIO - let sortedSeq = Seq.sort randomSeq2 + let sortedSeq = Seq.sort randomSeq do! IO.putStrLn <| sprintf "Sorted: %A" sortedSeq do! IO.putStrLn <| sprintf "Random: %A" randomSeq } |> IO.run (** -If we do not ask for the second sequence, we get what was the original desired behaviour of the program: +> Sorted: seq [75121301; 124930198; 609009994; 824551074] +> Random: [824551074; 609009994; 75121301; 124930198] + +Notice that now, both sequences contain the same values. The generation of actual random numbers is triggered by the line `let! randomSeq = randomSeqIO` which makes the effect completely explicit. + +In order to get our program to behave like the original one that uses a sequence with side effects, we have to explicitly ask for a second set of evaluated effects. *) io { - let randomSeqIO = IO.replicateM (Random.nextIO) 20 + let randomSeqIO = IO.replicateM (Random.nextIO) 4 let! randomSeq = randomSeqIO - let sortedSeq = Seq.sort randomSeq + let! randomSeq2 = randomSeqIO // evaluate the effects of randomSeqIO again + let sortedSeq = Seq.sort randomSeq2 do! IO.putStrLn <| sprintf "Sorted: %A" sortedSeq do! IO.putStrLn <| sprintf "Random: %A" randomSeq } |> IO.run (** +> Sorted: seq [79034179; 1625119183; 1651455963; 1775638512] +> Random: [1801985798; 963004958; 1819358047; 292397249] + Hopefully this demonstrates how being explicit about when side-effects occur can massively improve the ability of developers to understand and reason about their code. *) diff --git a/docs/content/pickler.fsx b/docs/content/pickler.fsx index 7d4ad8f..7854bcb 100644 --- a/docs/content/pickler.fsx +++ b/docs/content/pickler.fsx @@ -154,6 +154,29 @@ let utf8PU = BinaryPickler.utf8PU (** +## Encoding Discriminated Unions (the `alt` combinator) + +Consider a simple data type: + +*) + +type Shape = + |Circle of float + |Rectangle of float * float + +let shapePU = + // create a pickler for the circle and recangle case, wrap takes a method of constructing and deconstructing each case + let circlePU = BinaryPickler.wrap (Circle, function Circle r -> r) BinaryPickler.floatPU + let rectanglePU = BinaryPickler.wrap (Rectangle, function Rectangle (w, h) -> w, h) (BinaryPickler.tuple2 BinaryPickler.floatPU BinaryPickler.floatPU) + // a tag map : 0 -> circle, 1 -> rectangle defining which PU to use for which tag + let altMap = Map.ofList [(0, circlePU); (1, rectanglePU)] + // use the alt combinator and the deconstruction of Shape to the tags defined above + BinaryPickler.alt (function | Circle _ -> 0 | Rectangle _ -> 1) altMap + +(** + +The `alt` combinator is the key to this process. It accepts a function that deconstructs a data type into a simple numeric tag and a `Map` which defines the PU to use internally for each of the cases. + ## Incremental Pickling In many cases, especially when dealing with large binary files, it could be desirable to not have to convert back and forth between extremely large byte arrays, indeed this approach might not be viable due to available memory. diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index 5633e4c..260c69f 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -18,25 +18,26 @@ namespace NovelFS.NovelIO.BinaryPickler open NovelFS.NovelIO -type EagerBinaryPU<'a> = private {Pickle : 'a * BPickleState -> BPickleState; Unpickle : BUnpickleState -> 'a * BUnpickleState} +type BasicBinaryPU<'a> = private {Pickle : 'a * BPickleState -> BPickleState; Unpickle : BUnpickleState -> 'a * BUnpickleState} /// A pickler/unpickler pair for type 'a type BinaryPU<'a> = - |EagerPU of EagerBinaryPU<'a> - |LazyPU of (unit -> BinaryPU<'a>) - + /// A PU containing a BasicBinaryPU which is resolvable immediately + |FinalPU of BasicBinaryPU<'a> + /// A recursive PU containing a PU generating expression which is resolved when the PU is run + |RecursivePU of (unit -> BinaryPU<'a>) /// Provides functions for pickling binary data module BinaryPickler = let rec private runUnpickle state x = match x with - |EagerPU{Unpickle = g; Pickle = _} -> g state - |LazyPU y -> runUnpickle state (y()) + |FinalPU {Unpickle = g; Pickle = _} -> g state + |RecursivePU y -> runUnpickle state (y()) let rec private runPickle (a, st) x = match x with - |EagerPU{Unpickle = _; Pickle = g} -> g (a, st) - |LazyPU y -> runPickle (a,st) (y()) + |FinalPU {Unpickle = _; Pickle = g} -> g (a, st) + |RecursivePU y -> runPickle (a,st) (y()) /// Uses the supplied pickler/unpickler pair (PU) to unpickle the supplied byte array into some type 'a @@ -71,15 +72,14 @@ module BinaryPickler = /// Helper function that chooses between complete or incremental unpickling and gets the size from the size of the data type let private unpickleHelper (f : int -> byte array -> 'a) st = unpickleHelperSized (sizeof<'a>) f st - /// Given a value of x, returns a PU of x without affecting the underlying read/write states - let lift x = EagerPU{Pickle = (fun (_,st) -> st); Unpickle = (fun s -> x, s)} + let lift x = FinalPU{Pickle = (fun (_,st) -> st); Unpickle = (fun s -> x, s)} /// Creates a sequential combination of PU let rec sequ (f : 'b -> 'a) (pa : BinaryPU<'a>) (k : 'a -> BinaryPU<'b>) : BinaryPU<'b> = match pa with - |EagerPU{Unpickle = unPck; Pickle = pck} -> + |FinalPU{Unpickle = unPck; Pickle = pck} -> // unpickling is sequenced like bind in the state monad let unPck' s = let a, s' = runUnpickle s pa @@ -89,10 +89,10 @@ module BinaryPickler = let a = f b let pb = k a runPickle (b, runPickle (a, s) pa) pb - EagerPU{Unpickle = unPck'; Pickle = pck'} - |LazyPU y -> + FinalPU{Unpickle = unPck'; Pickle = pck'} + |RecursivePU y -> let lazySequ = fun () -> sequ f (y()) k - LazyPU lazySequ + RecursivePU lazySequ /// Combines two PU into a PU that pickles a tuple-2 let tuple2 pa pb = @@ -145,9 +145,12 @@ module BinaryPickler = /// Repeats a PU n times to create an array pickler let repeatA pa n = wrap (Array.ofList, List.ofArray) (repeat pa n) + /// A pickler/unpickler pair (PU) for the unit type + let unitPU = lift () + /// A pickler/unpickler pair (PU) for bools let boolPU = - EagerPU + FinalPU { Pickle = fun (b, s) -> pickleHelper (PickleConvertors.convFromBool) b s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToBool) st @@ -155,7 +158,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for bytes let bytePU = - EagerPU + FinalPU { Pickle = fun (b, s) -> pickleHelper (Array.singleton) b s Unpickle = fun st -> unpickleHelper (Array.item) st @@ -163,7 +166,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for int16s of the supplied endianness let private int16PUE endianness = - EagerPU + FinalPU { Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromInt16 endianness) i16 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt16 endianness) st @@ -171,7 +174,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for uint16s of the supplied endianness let private uint16PUE endianness = - EagerPU + FinalPU { Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromUInt16 endianness) i16 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt16 endianness) st @@ -179,7 +182,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for int32s of the supplied endianness let private int32PUE endianness = - EagerPU + FinalPU { Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromInt32 endianness) i32 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt32 endianness) st @@ -187,7 +190,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for uint32s of the supplied endianness let private uint32PUE endianness = - EagerPU + FinalPU { Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromUInt32 endianness) i32 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt32 endianness) st @@ -195,7 +198,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for int64s of the supplied endianness let private int64PUE endianness = - EagerPU + FinalPU { Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromInt64 endianness) i64 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt64 endianness) st @@ -203,7 +206,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for uint64s of the supplied endianness let private uint64PUE endianness = - EagerPU + FinalPU { Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromUInt64 endianness) i64 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt64 endianness) st @@ -211,7 +214,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for float32s of the supplied endianness let private float32PUE endianness = - EagerPU + FinalPU { Pickle = fun (f32, s) -> pickleHelper (PickleConvertors.convFromFloat32 endianness) f32 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat32 endianness) st @@ -219,7 +222,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for floats of the supplied endianness let private floatPUE endianness = - EagerPU + FinalPU { Pickle = fun (f64, s) -> pickleHelper (PickleConvertors.convFromFloat64 endianness) f64 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat64 endianness) st @@ -231,7 +234,7 @@ module BinaryPickler = wrap (intAToDecimal, System.Decimal.GetBits) (repeatA (int32PUE endianness) 4) let private byteLengthPrefixE fPickle fConv endianness pu = - EagerPU + FinalPU { Pickle = fun (v, s) -> pickleHelper (fun v' -> @@ -284,8 +287,12 @@ module BinaryPickler = let decimalPU = decimalPUE (ByteOrder.systemEndianness) /// Accepts a tagging function that partitions the type to be pickled/unpickled into two sets, then accepts a PU for each set. This permits - /// creating PUs that might pickle one of several alternatives - let altE endianness tag ps = sequ tag (int32PUE endianness) (flip Map.find <| ps) + /// creating PUs that might pickle one of several alternatives. The tag is stored using the supplied endianness. + let private altE endianness tag ps = sequ tag (int32PUE endianness) (flip Map.find <| ps) + + /// Accepts a tagging function that partitions the type to be pickled/unpickled into two sets, then accepts a PU for each set. This permits + /// creating PUs that might pickle one of several alternatives. The tag is stored in the Endianness of the current platform + let alt tag ps = altE (ByteOrder.systemEndianness) tag ps /// A pickler/unpickler pair (PU) for lists which prefixes the length using the Endianness of the current platform let list pa = sequ (List.length) intPU << repeat <| pa @@ -332,7 +339,7 @@ module BinaryPickler = /// Creates a pickler/unpickler pair (PU) for strings using the supplied encoding let encodingPU encoding = let pickleEncodingS byteCount = - EagerPU + FinalPU { Pickle = fun (str, s) -> pickleHelper (PickleConvertors.Encodings.convFromEncoding encoding) str s Unpickle = fun st -> unpickleHelperSized byteCount (PickleConvertors.Encodings.convToEncoding encoding byteCount) st @@ -398,6 +405,10 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in Little Endian byte order let byteLengthPrefixed pu = intByteLengthPrefixE LittleEndian pu + /// Accepts a tagging function that partitions the type to be pickled/unpickled into two sets, then accepts a PU for each set. This permits + /// creating PUs that might pickle one of several alternatives. The tag is stored in Little Endian byte order + let alt tag ps = altE LittleEndian tag ps + /// A pickler/unpickler pair (PU) for option types in the Endianness in Little Endian byte order let optional pa = optionalPUE LittleEndian pa @@ -436,6 +447,10 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) that prefixes the byte length of the structure in Big Endian byte order let byteLengthPrefixed pu = intByteLengthPrefixE BigEndian pu + /// Accepts a tagging function that partitions the type to be pickled/unpickled into two sets, then accepts a PU for each set. This permits + /// creating PUs that might pickle one of several alternatives. The tag is stored in Big Endian byte order + let alt tag ps = altE BigEndian tag ps + /// A pickler/unpickler pair (PU) for option types in the Endianness in Big Endian byte order let optional pa = optionalPUE BigEndian pa From 97fb81a23a2cbe39ab87cf0c9e73f81caec16cd6 Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Mon, 4 Jul 2016 21:08:28 +0100 Subject: [PATCH 05/13] Renamed FinalPU again to PU --- src/NovelIO/BinaryPickler.fs | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index 260c69f..5437c04 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -23,7 +23,7 @@ type BasicBinaryPU<'a> = private {Pickle : 'a * BPickleState -> BPickleState; Un /// A pickler/unpickler pair for type 'a type BinaryPU<'a> = /// A PU containing a BasicBinaryPU which is resolvable immediately - |FinalPU of BasicBinaryPU<'a> + |PU of BasicBinaryPU<'a> /// A recursive PU containing a PU generating expression which is resolved when the PU is run |RecursivePU of (unit -> BinaryPU<'a>) @@ -31,12 +31,12 @@ type BinaryPU<'a> = module BinaryPickler = let rec private runUnpickle state x = match x with - |FinalPU {Unpickle = g; Pickle = _} -> g state + |PU {Unpickle = g; Pickle = _} -> g state |RecursivePU y -> runUnpickle state (y()) let rec private runPickle (a, st) x = match x with - |FinalPU {Unpickle = _; Pickle = g} -> g (a, st) + |PU {Unpickle = _; Pickle = g} -> g (a, st) |RecursivePU y -> runPickle (a,st) (y()) @@ -74,12 +74,12 @@ module BinaryPickler = unpickleHelperSized (sizeof<'a>) f st /// Given a value of x, returns a PU of x without affecting the underlying read/write states - let lift x = FinalPU{Pickle = (fun (_,st) -> st); Unpickle = (fun s -> x, s)} + let lift x = PU{Pickle = (fun (_,st) -> st); Unpickle = (fun s -> x, s)} /// Creates a sequential combination of PU let rec sequ (f : 'b -> 'a) (pa : BinaryPU<'a>) (k : 'a -> BinaryPU<'b>) : BinaryPU<'b> = match pa with - |FinalPU{Unpickle = unPck; Pickle = pck} -> + |PU{Unpickle = unPck; Pickle = pck} -> // unpickling is sequenced like bind in the state monad let unPck' s = let a, s' = runUnpickle s pa @@ -89,7 +89,7 @@ module BinaryPickler = let a = f b let pb = k a runPickle (b, runPickle (a, s) pa) pb - FinalPU{Unpickle = unPck'; Pickle = pck'} + PU{Unpickle = unPck'; Pickle = pck'} |RecursivePU y -> let lazySequ = fun () -> sequ f (y()) k RecursivePU lazySequ @@ -150,7 +150,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for bools let boolPU = - FinalPU + PU { Pickle = fun (b, s) -> pickleHelper (PickleConvertors.convFromBool) b s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToBool) st @@ -158,7 +158,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for bytes let bytePU = - FinalPU + PU { Pickle = fun (b, s) -> pickleHelper (Array.singleton) b s Unpickle = fun st -> unpickleHelper (Array.item) st @@ -166,7 +166,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for int16s of the supplied endianness let private int16PUE endianness = - FinalPU + PU { Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromInt16 endianness) i16 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt16 endianness) st @@ -174,7 +174,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for uint16s of the supplied endianness let private uint16PUE endianness = - FinalPU + PU { Pickle = fun (i16, s) -> pickleHelper (PickleConvertors.convFromUInt16 endianness) i16 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt16 endianness) st @@ -182,7 +182,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for int32s of the supplied endianness let private int32PUE endianness = - FinalPU + PU { Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromInt32 endianness) i32 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt32 endianness) st @@ -190,7 +190,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for uint32s of the supplied endianness let private uint32PUE endianness = - FinalPU + PU { Pickle = fun (i32, s) -> pickleHelper (PickleConvertors.convFromUInt32 endianness) i32 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt32 endianness) st @@ -198,7 +198,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for int64s of the supplied endianness let private int64PUE endianness = - FinalPU + PU { Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromInt64 endianness) i64 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToInt64 endianness) st @@ -206,7 +206,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for uint64s of the supplied endianness let private uint64PUE endianness = - FinalPU + PU { Pickle = fun (i64, s) -> pickleHelper (PickleConvertors.convFromUInt64 endianness) i64 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToUInt64 endianness) st @@ -214,7 +214,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for float32s of the supplied endianness let private float32PUE endianness = - FinalPU + PU { Pickle = fun (f32, s) -> pickleHelper (PickleConvertors.convFromFloat32 endianness) f32 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat32 endianness) st @@ -222,7 +222,7 @@ module BinaryPickler = /// A pickler/unpickler pair (PU) for floats of the supplied endianness let private floatPUE endianness = - FinalPU + PU { Pickle = fun (f64, s) -> pickleHelper (PickleConvertors.convFromFloat64 endianness) f64 s Unpickle = fun st -> unpickleHelper (PickleConvertors.convToFloat64 endianness) st @@ -234,7 +234,7 @@ module BinaryPickler = wrap (intAToDecimal, System.Decimal.GetBits) (repeatA (int32PUE endianness) 4) let private byteLengthPrefixE fPickle fConv endianness pu = - FinalPU + PU { Pickle = fun (v, s) -> pickleHelper (fun v' -> @@ -339,7 +339,7 @@ module BinaryPickler = /// Creates a pickler/unpickler pair (PU) for strings using the supplied encoding let encodingPU encoding = let pickleEncodingS byteCount = - FinalPU + PU { Pickle = fun (str, s) -> pickleHelper (PickleConvertors.Encodings.convFromEncoding encoding) str s Unpickle = fun st -> unpickleHelperSized byteCount (PickleConvertors.Encodings.convToEncoding encoding byteCount) st From 9d66c6b626a80b73e4a934a6e26ecd79c3c73bfe Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Fri, 8 Jul 2016 02:20:26 +0100 Subject: [PATCH 06/13] Support for the bracket pattern Added withFileHandle as defined handle lifetime approach for opening files Added TCP accept/fork with defined socket lifetime --- src/NovelIO/File.fs | 4 ++++ src/NovelIO/IO.fs | 20 ++++++++++++++------ src/NovelIO/TCP.fs | 11 ++++++++--- tests/NovelIO.IntegrationTests/TCPTests.fs | 4 ++-- 4 files changed, 28 insertions(+), 11 deletions(-) diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index ce6f926..e0f9028 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -100,6 +100,10 @@ module File = let openFileHandle mode access (fName : Filename) = IO.fromEffectful (fun _ -> SideEffectingIO.openFileHandle fName mode access) + /// Opens a handle to the specified file using the supplied file mode and performs the supplied computation fHandle with the handle before cleaning it up. + let withFileHandle mode access (fName : Filename) fHandle = + IO.bracket (openFileHandle mode access fName) (IO.hClose) fHandle + /// Reads all the bytes from a specified file as an array let readAllBytes filename = IO.fromEffectful(fun _ -> File.ReadAllBytes <| getPathString filename) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 3e28df3..fd50d24 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -129,12 +129,6 @@ module IO = |Return a -> f a |Delay (g) -> Delay (fun _ -> bind (g ()) f) - let private using (x : #System.IDisposable) f : IO<'b> = - try - f x - finally - x.Dispose() - /// Computation Expression builder for IO actions type IOBuilder() = /// Return a value as an IO action @@ -204,6 +198,8 @@ module IO = /// An action that writes a line to console let putStrLn (str : string) = fromEffectful (fun _ -> System.Console.WriteLine str) + + // ------- RUN ------- // /// Runs the IO actions and evaluates the result @@ -214,6 +210,18 @@ module IO = |Delay (a) -> runRec <| a() runRec io + + /// 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 { + let! a = act + return! fromEffectful (fun _ -> + try + run <| fBind a + finally + ignore << run <| fClnUp a) + } + /// Runs the IO actions and evaluates the result, handling success or failure using IOResult let runGuarded io = // run recursively and handle exceptions in IO diff --git a/src/NovelIO/TCP.fs b/src/NovelIO/TCP.fs index 5d584fb..fbb5ee1 100644 --- a/src/NovelIO/TCP.fs +++ b/src/NovelIO/TCP.fs @@ -26,18 +26,23 @@ module Network = /// Provides functions relating to TCP connections module TCP = + let private acceptConn serv = IO.fromEffectful (fun () -> SideEffectingIO.acceptSocketFromServer serv) + /// Create a TCP server at the specfied IP on the specified port let createServer ip port = IO.fromEffectful (fun () -> SideEffectingIO.startTCPServer ip port) /// Create a TCP server at the specfied IP let createServerOnFreePort ip = IO.fromEffectful (fun () -> SideEffectingIO.startTCPServer ip 0) - /// Accept a connection from the supplied TCP server - let acceptConnection serv = IO.fromEffectful (fun () -> SideEffectingIO.acceptSocketFromServer serv) - /// Close a connected socket let closeConnection socket = IO.fromEffectful (fun () -> SideEffectingIO.closeSocket socket) + /// Accept a connection from the supplied TCP server and handle it with the supplied function + let acceptConnection serv f = IO.bracket (acceptConn serv) (closeConnection) (f) + + /// Accept a connection from the supplied TCP server and handle it with the supplied function on a different thread + let acceptFork serv f = IO.forkIO <| acceptConnection serv f + /// Create a TCP connection to the supplied IP and specified port let connectSocket ip port = IO.fromEffectful (fun () -> SideEffectingIO.connectTCPSocket ip port) diff --git a/tests/NovelIO.IntegrationTests/TCPTests.fs b/tests/NovelIO.IntegrationTests/TCPTests.fs index b5bdf89..57e6fd7 100644 --- a/tests/NovelIO.IntegrationTests/TCPTests.fs +++ b/tests/NovelIO.IntegrationTests/TCPTests.fs @@ -27,7 +27,7 @@ type ``TCP Integration Tests``() = let port = IO.run <| io{ let! server = TCP.createServerOnFreePort (IPAddress.Any) let! port = TCP.getServerPort server - do! IO.forkIO <| TCP.acceptConnection server // fork the client acceptance to new thread so we can return the port immediately + do! TCP.acceptFork server (fun _ -> IO.return' ()) // fork the client acceptance to new thread so we can return the port immediately return port } use client = new System.Net.Sockets.TcpClient() @@ -40,7 +40,7 @@ type ``TCP Integration Tests``() = IO.run <| io{ let! server = TCP.createServerOnFreePort (IPAddress.Any) let! port = TCP.getServerPort server - do! IO.forkIO <| TCP.acceptConnection server // fork the client acceptance to new thread so we can return the port immediately + do! TCP.acceptFork server (fun _ -> IO.return' ()) // fork the client acceptance to new thread so we can return the port immediately let! sock = TCP.connectSocket (IPAddress.Loopback) port return () } From 2017696b4f6a7c36ba9c051a7d54dd959bc72ab1 Mon Sep 17 00:00:00 2001 From: Phil Date: Fri, 8 Jul 2016 23:02:34 +0100 Subject: [PATCH 07/13] Added bracket pattern tests --- tests/NovelIO.UnitTests/IOTests.fs | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/tests/NovelIO.UnitTests/IOTests.fs b/tests/NovelIO.UnitTests/IOTests.fs index c505f3e..125a4c4 100644 --- a/tests/NovelIO.UnitTests/IOTests.fs +++ b/tests/NovelIO.UnitTests/IOTests.fs @@ -65,4 +65,25 @@ type ``IO Unit Tests``() = static member ``mapM 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 - true \ No newline at end of file + true + + [] + static member ``bracket calls close action if exception thrown`` () = + let create = IO.return' () + let mutable called = false + let closed = IO.fromEffectful (fun _ -> called <- true) + let expt = IO.fromEffectful (fun _ -> failwith "test exception") + try + IO.bracket create (fun _ -> closed) (fun _ -> expt) |> IO.run + with + exn -> () + called = true + + [] + static member ``bracket calls close action if exception not thrown`` () = + let create = IO.return' () + let mutable called = false + 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 From db17caa25ddd5133e164c09126109e85f076206b Mon Sep 17 00:00:00 2001 From: Phil Date: Sat, 9 Jul 2016 15:32:49 +0100 Subject: [PATCH 08/13] Changed name of 'Handle' and 'BinaryHandle' to 'TChannel' and 'BChannel'. These then have modules 'TextChannel' and 'BinaryChannel' associated with them to contain associated functions. Moved side effecting functions out of IO.fs and in to other files depending on their function. Updated bracket pattern test so that it only catches a specific exception. Updated docs to reflect these changes. --- docs/content/index.fsx | 4 +- docs/content/motivation.fsx | 99 ++++++----- docs/content/oopintro.fsx | 2 +- docs/content/pickler.fsx | 10 +- src/NovelIO/BinaryPickler.fs | 16 +- src/NovelIO/Channels.fs | 123 +++++++++++++ src/NovelIO/File.fs | 46 ++++- src/NovelIO/Helper.fs | 4 +- src/NovelIO/IO.fs | 118 +------------ src/NovelIO/MemoryBuffer.fs | 8 +- src/NovelIO/NovelIO.fsproj | 1 + src/NovelIO/Prelude.fs | 26 +-- src/NovelIO/Scripts/load-project-debug.fsx | 1 + src/NovelIO/TCP.fs | 36 +++- tests/NovelIO.UnitTests/BinaryTests.fs | 196 ++++++++++----------- tests/NovelIO.UnitTests/IOTests.fs | 9 +- 16 files changed, 386 insertions(+), 313 deletions(-) create mode 100644 src/NovelIO/Channels.fs diff --git a/docs/content/index.fsx b/docs/content/index.fsx index 5d6e3b7..5c10294 100644 --- a/docs/content/index.fsx +++ b/docs/content/index.fsx @@ -86,8 +86,8 @@ In order to execute items in parallel, we can simply build a list of the IO acti io { let fName = File.assumeValidFilename "file.txt" - let! handle = File.openFileHandle FileMode.Open FileAccess.Read fName - return IO.Parallel.par [Console.readLine; IO.hGetLine handle] + let! channel = File.openTextChannel FileMode.Open FileAccess.Read 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 9d751e2..606e338 100644 --- a/docs/content/motivation.fsx +++ b/docs/content/motivation.fsx @@ -48,51 +48,6 @@ Once again, we can freely replace `yPure` and `Random.nextIO` wherever they appe As mentioned in the introduction, `IO.run` is the only non-referentially transparent function exposed by this library and, as such, should be used sparingly! -## 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. - ## Side-effects and lazy evaluation In general, writing code that combines side effects and lazy evaluation can be complex and error prone, the developer can often be left with little idea when effects will actually be triggered. @@ -209,10 +164,10 @@ In order to get our program to behave like the original one that uses a sequence io { let randomSeqIO = IO.replicateM (Random.nextIO) 4 let! randomSeq = randomSeqIO + let sortedSeq = Seq.sort randomSeq // sort the first set let! randomSeq2 = randomSeqIO // evaluate the effects of randomSeqIO again - let sortedSeq = Seq.sort randomSeq2 do! IO.putStrLn <| sprintf "Sorted: %A" sortedSeq - do! IO.putStrLn <| sprintf "Random: %A" randomSeq + do! IO.putStrLn <| sprintf "Random: %A" randomSeq2 } |> IO.run (** @@ -220,6 +175,54 @@ io { > Sorted: seq [79034179; 1625119183; 1651455963; 1775638512] > Random: [1801985798; 963004958; 1819358047; 292397249] -Hopefully this demonstrates how being explicit about when side-effects occur can massively improve the ability of developers to understand and reason about their code. +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 8af2a11..bc1373f 100644 --- a/docs/content/oopintro.fsx +++ b/docs/content/oopintro.fsx @@ -60,7 +60,7 @@ open NovelFS.NovelIO.BinaryPickler let readIntFromFile file = io { let! bytes = File.readAllBytes file - return BinaryPickler.unpickle (BinaryPickler.pickleInt32) bytes + return BinaryPickler.unpickle (BinaryPickler.intPU) bytes } (** diff --git a/docs/content/pickler.fsx b/docs/content/pickler.fsx index 7854bcb..32d2cda 100644 --- a/docs/content/pickler.fsx +++ b/docs/content/pickler.fsx @@ -183,15 +183,15 @@ In many cases, especially when dealing with large binary files, it could be desi In this case, we can use incremental pickling to read/write as part of the pickling process. Unlike the simple conversion process shown above, this action is effectful so is encapsulated within `IO`. -This process is quite simple, instead of using the `pickle` and `unpickle` functions, we use the `pickleIncr` and `unpickleIncr` functions. These simply take the additional argument of a `BinaryHandle` upon which they will act. +This process is quite simple, instead of using the `pickle` and `unpickle` functions, we use the `pickleIncr` and `unpickleIncr` functions. These simply take the additional argument of a `BChannel` upon which they will act. Example of incremental unpickling: *) io { - let! handle = File.openBinaryHandle FileMode.Open FileAccess.Read (File.assumeValidFilename "test.txt") - return! BinaryPickler.unpickleIncr complexPickler handle + let! channel = File.openBinaryChannel FileMode.Open FileAccess.Read (File.assumeValidFilename "test.txt") + return! BinaryPickler.unpickleIncr complexPickler channel } (** @@ -201,7 +201,7 @@ Example of incremental pickling: *) io { - let! handle = File.openBinaryHandle FileMode.Create FileAccess.Write (File.assumeValidFilename "test.txt") + let! channel = File.openBinaryChannel FileMode.Create FileAccess.Write (File.assumeValidFilename "test.txt") let data = [("A", 7.5, 16); ("B", 7.5, 1701)] - return! BinaryPickler.pickleIncr complexPickler handle data + return! BinaryPickler.pickleIncr complexPickler channel data } \ No newline at end of file diff --git a/src/NovelIO/BinaryPickler.fs b/src/NovelIO/BinaryPickler.fs index 5437c04..be49fd6 100644 --- a/src/NovelIO/BinaryPickler.fs +++ b/src/NovelIO/BinaryPickler.fs @@ -462,24 +462,24 @@ module BinaryPickler = /// mark to indicate this is prepended. let utf32PU = pickleUTFXWithEndiannessDetect (Encoding.UTF32 {Endianness = LittleEndian; ByteOrderMark = true}) LittleEndian.utf32PU BigEndian.utf16PU - /// Uses the supplied pickler/unpickler pair (PU) to unpickle from the supplied binary handle incrementally - let unpickleIncr pu binaryHandle = - match binaryHandle.BinaryReader with + /// 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} IO.fromEffectful (fun _ -> fst <| runUnpickle (incrUnpickler) pu) - |None -> raise HandleDoesNotSupportReadingException + |None -> raise ChannelDoesNotSupportReadingException - /// Uses the supplied pickler/unpickler pair (PU) to pickle the supplied data to the supplied binary handle incrementally - let pickleIncr pu binaryHandle value = - match binaryHandle.BinaryWriter with + /// 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} IO.fromEffectful (fun _ -> match (runPickle (value, incrPickler) pu) with |PickleIncremental ps -> binWriter.Flush() |_ -> invalidOp "A non-incremental binary pickler state was returned from an initially incremental pickler") - |None -> raise HandleDoesNotSupportReadingException + |None -> raise ChannelDoesNotSupportReadingException diff --git a/src/NovelIO/Channels.fs b/src/NovelIO/Channels.fs new file mode 100644 index 0000000..ceef383 --- /dev/null +++ b/src/NovelIO/Channels.fs @@ -0,0 +1,123 @@ +(* + 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 + +open System.IO + +/// Operations on text channels +module TextChannel = + module private SideEffecting = + /// Writes a a string to the text channel with a supplied function + let putStrF f channel = + match channel.TextWriter with + |Some txtWrtr -> + f txtWrtr + txtWrtr.Flush() + |None -> raise ChannelDoesNotSupportWritingException + /// Close a text channel + let close channel = + match channel.TextReader with + |Some txtRdr -> txtRdr.Close() + |None -> () + match channel.TextWriter with + |Some txtWtr -> txtWtr.Close() + |None -> () + /// Gets a line from a text channel + let getLine channel = + match channel.TextReader with + |Some txtRdr -> txtRdr.ReadLine() + |None -> raise ChannelDoesNotSupportReadingException + /// Writes a string to a text channel + let putStr (str : string) channel = + putStrF (fun txtWrtr -> txtWrtr.Write str) channel + /// Writes a string line to a text channel + let putStrLn (str : string) channel = + putStrF (fun txtWrtr -> txtWrtr.WriteLine str) channel + /// Determines whether a supplied text channel is ready to be read from + let isChannelReadyToRead channel = + match channel.TextReader with + |Some txtRdr -> txtRdr.Peek() = -1 + |None -> raise ChannelDoesNotSupportReadingException + + /// An action that closes a text channel + 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) + + /// An action that determines if the text channel has data available + 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) + +/// Operations on binary channels +module BinaryChannel = + module private 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 -> () + /// 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 + + /// An action that closes a binary channel + let close channel = IO.fromEffectful (fun _ -> SideEffecting.close channel) + + /// 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) + + /// 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) + + /// 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) + + /// 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 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 diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index e0f9028..3f9b2ac 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -31,6 +31,30 @@ module private SideEffectingFileIO = (toFileInfo file).Length |> LanguagePrimitives.Int64WithMeasure + /// Create a file channel for a supplied file name, file mode and file access + let openTextFileChannel (fName : Filename) mode access = + let crTxtRdr (fStream : FileStream) = new StreamReader(fStream) :> TextReader + let crTxtWrtr (fStream : FileStream) = new StreamWriter(fStream) :> TextWriter + let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) + 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} + + /// Create a binary file channel for a supplied file name, file mode and file access + let openBinaryFileChannel (fName : Filename) 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} + /// Provides functions relating to the creating, copying, deleting, moving, opening and reading of files module File = /// Turns a string into a filename by assuming the supplied string is a valid filename. @@ -92,17 +116,21 @@ module File = let move sourceFile destFile = IO.fromEffectful (fun _ -> File.Move(getPathString sourceFile, getPathString destFile)) - /// Opens a handle to the specified file using the supplied file mode - let openBinaryHandle mode access (fName : Filename) = - IO.fromEffectful (fun _ -> SideEffectingIO.openBinaryFileHandle fName mode access) + /// Opens a channel to the specified file using the supplied file mode + let openBinaryChannel mode access (fName : Filename) = + 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 = + IO.bracket (openBinaryChannel mode access fName) (BinaryChannel.close) fChannel - /// Opens a handle to the specified file using the supplied file mode - let openFileHandle mode access (fName : Filename) = - IO.fromEffectful (fun _ -> SideEffectingIO.openFileHandle fName mode access) + /// Opens a channel to the specified file using the supplied file mode + let openTextChannel mode access (fName : Filename) = + IO.fromEffectful (fun _ -> SideEffectingFileIO.openTextFileChannel fName mode access) - /// Opens a handle to the specified file using the supplied file mode and performs the supplied computation fHandle with the handle before cleaning it up. - let withFileHandle mode access (fName : Filename) fHandle = - IO.bracket (openFileHandle mode access fName) (IO.hClose) fHandle + /// 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 = + IO.bracket (openTextChannel mode access fName) (TextChannel.close) fChannel /// Reads all the bytes from a specified file as an array let readAllBytes filename = diff --git a/src/NovelIO/Helper.fs b/src/NovelIO/Helper.fs index 7610d8c..041dbaf 100644 --- a/src/NovelIO/Helper.fs +++ b/src/NovelIO/Helper.fs @@ -24,8 +24,8 @@ module internal InternalIOHelper = try f a |> IOSuccess with - | HandleDoesNotSupportReadingException -> HandleDoesNotSupportReading |> IOError - | HandleDoesNotSupportWritingException -> HandleDoesNotSupportWriting |> IOError + | 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 diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index fd50d24..1f98c01 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -25,98 +25,6 @@ type IO<'a> = |Return of 'a |Delay of (unit -> IO<'a>) -/// Side effecting helper functions - this is where ugly things happen -module internal SideEffectingIO = - /// Hidden helper functions - module private Helpers = - /// Writes a a string to the console with a supplied function - let hPutStrF f handle = - match handle.TextWriter with - |Some txtWrtr -> - f txtWrtr - txtWrtr.Flush() - |None -> raise HandleDoesNotSupportWritingException - /// Accept a socket from a TCP Server - let acceptSocketFromServer serv = - {TCPConnectedSocket = serv.TCPListener.AcceptSocket()} - /// 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 - /// Close a binary handle - let bhClose handle = - match handle.BinaryReader with - |Some binRdr -> binRdr.Close() - |None -> () - match handle.BinaryReader with - |Some binWtr -> binWtr.Close() - |None -> () - /// Close a handle - let hClose handle = - match handle.TextReader with - |Some txtRdr -> txtRdr.Close() - |None -> () - match handle.TextWriter with - |Some txtWtr -> txtWtr.Close() - |None -> () - /// Gets a line from a handle - let hGetLine handle = - match handle.TextReader with - |Some txtRdr -> txtRdr.ReadLine() - |None -> raise HandleDoesNotSupportReadingException - /// Writes a string to a handle - let hPutStr (str : string) handle = - Helpers.hPutStrF (fun txtWrtr -> txtWrtr.Write str) handle - /// Writes a string line to a handle - let hPutStrLn (str : string) handle = - Helpers.hPutStrF (fun txtWrtr -> txtWrtr.WriteLine str) handle - /// Determines whether a supplied handle is ready to be read from - let isHandleReadyToRead handle = - match handle.TextReader with - |Some txtRdr -> txtRdr.Peek() = -1 - |None -> raise HandleDoesNotSupportReadingException - /// Create a file handle for a supplied file name, file mode and file access - let openFileHandle (fName : Filename) mode access = - let crTxtRdr (fStream : FileStream) = new StreamReader(fStream) :> TextReader - let crTxtWrtr (fStream : FileStream) = new StreamWriter(fStream) :> TextWriter - let fStream = new FileStream(fName.PathString, InternalIOHelper.fileModeToSystemIOFileMode mode, InternalIOHelper.fileAccessToSystemIOFileAccess access) - 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} - /// Create a binary file handle for a supplied file name, file mode and file access - let openBinaryFileHandle (fName : Filename) 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} - - /// Sets the absolute position of the binary handle - let bhSetAbsPosition pos bHandle = - match bHandle.BinaryReader with - |Some br -> br.BaseStream.Position <- pos - |_ -> () - match bHandle.BinaryWriter with - |Some bw -> bw.BaseStream.Position <- pos - |_ -> () - - /// Start a TCP server on a supplied ip address and port - let startTCPServer ip port = - let listener = Sockets.TcpListener(ip, port) - listener.Start() - {TCPListener = listener} - /// Pure IO Functions module IO = /// Return a value as an IO action @@ -176,30 +84,10 @@ module IO = let lift2 f x1 x2 = f x1 <*> x2 // ----- GENERAL ----- // - - /// An action that closes a binary handle - let bhClose handle = fromEffectful (fun _ -> SideEffectingIO.bhClose handle) - - /// An action that sets the position of the binary handle to the supplied absolute position - let bhSetAbsPosition bHandle pos = fromEffectful (fun _ -> SideEffectingIO.bhSetAbsPosition pos bHandle) - - /// An action that closes a handle - let hClose handle = fromEffectful (fun _ -> SideEffectingIO.hClose handle) - - /// An action that reads a line from the file or channel - let hGetLine handle = fromEffectful (fun _ -> SideEffectingIO.hGetLine handle) - - /// An action that determines if the handle has data available - let hIsReady handle = fromEffectful (fun _ -> SideEffectingIO.isHandleReadyToRead handle) - - /// An action that writes a line to the final or channel - let hPutStrLn handle str = fromEffectful (fun _ -> SideEffectingIO.hPutStrLn str handle) /// An action that writes a line to console let putStrLn (str : string) = fromEffectful (fun _ -> System.Console.WriteLine str) - - // ------- RUN ------- // /// Runs the IO actions and evaluates the result @@ -224,7 +112,7 @@ module IO = /// Runs the IO actions and evaluates the result, handling success or failure using IOResult let runGuarded io = - // run recursively and handle exceptions in 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 @@ -389,8 +277,10 @@ module IO = module Console = /// An action that reads a key from the console let readKey = IO.fromEffectful (fun () -> System.Console.ReadKey()) - /// Ac action that reads a line from the console + /// An action that reads a line from the console let readLine = IO.fromEffectful (fun () -> System.Console.ReadLine()) + /// An action that writes a line to the console + let writeLine (str : string) = IO.fromEffectful (fun () -> System.Console.WriteLine str) /// Threading functions module Thread = diff --git a/src/NovelIO/MemoryBuffer.fs b/src/NovelIO/MemoryBuffer.fs index 69f6552..3d551c6 100644 --- a/src/NovelIO/MemoryBuffer.fs +++ b/src/NovelIO/MemoryBuffer.fs @@ -27,14 +27,14 @@ module MemoryBuffer = /// Creates a non-expandable memory buffer from the supplied byte array let createFromByteArray (arr : byte array) = {MemStream = new MemoryStream(arr)} - /// Create a handle from a memory buffer - let bufferToHandle buffer = + /// Create a channel from a memory buffer + let bufferToTextChannel buffer = IO.return' {TextReader = new StreamReader(buffer.MemStream) :> TextReader |> Some; TextWriter = new StreamWriter(buffer.MemStream) :> TextWriter |> Some} - /// Create a binary handle from a memory buffer - let bufferToBinaryHandle buffer = + /// 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} diff --git a/src/NovelIO/NovelIO.fsproj b/src/NovelIO/NovelIO.fsproj index d7aba1c..bcaa2a7 100644 --- a/src/NovelIO/NovelIO.fsproj +++ b/src/NovelIO/NovelIO.fsproj @@ -54,6 +54,7 @@ + diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index 196dc36..04c1b30 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -19,11 +19,11 @@ namespace NovelFS.NovelIO open System.IO open System.Net -/// Exception that occurs when attempting to write to a Handle that does not support writing -exception HandleDoesNotSupportWritingException +/// Exception that occurs when attempting to write to a Channel that does not support writing +exception ChannelDoesNotSupportWritingException -/// Exception that occurs when attempt to read from a Handle that does not support reading -exception HandleDoesNotSupportReadingException +/// 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> = @@ -47,10 +47,10 @@ and IOErrorResult = |UnauthourisedAccess of System.UnauthorizedAccessException /// IO failure due a stream being closed |StreamClosed of System.ObjectDisposedException - /// IO failure due to the supplied handle not supporting reading - |HandleDoesNotSupportReading - /// IO failure due to the supplied handle not supporting writing - |HandleDoesNotSupportWriting + /// 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 @@ -91,7 +91,7 @@ module PathDiscriminators = /// General functions of wide applicability [] module General = - /// Helper function that takes two arguments and throws away the second + /// Helper function that takes two arguments and throws away the second, returning the first let const' x _ = x /// When supplied with a function f, returns a new function that accepts the first and second arguments in the opposite order let flip f a b = f b a @@ -124,11 +124,11 @@ type FileAccess = /// Read and write access to a file |ReadWrite -/// A Handle that may support text being read from it and written to it -type Handle = private {TextReader : TextReader option; TextWriter : TextWriter option} +/// A channel that may support text being read from it and written to it +type TChannel = private {TextReader : TextReader option; TextWriter : TextWriter option} -/// A Binary Handle that may support binary data being read from it or written to it -type BinaryHandle = private {BinaryReader : BinaryReader option; BinaryWriter : BinaryWriter option} +/// A channel that may support binary data being read from it or written to it +type BChannel = private {BinaryReader : BinaryReader option; BinaryWriter : BinaryWriter option} /// A TCP Server type TCPServer = private {TCPListener : Sockets.TcpListener} diff --git a/src/NovelIO/Scripts/load-project-debug.fsx b/src/NovelIO/Scripts/load-project-debug.fsx index 0ed8519..81539cc 100644 --- a/src/NovelIO/Scripts/load-project-debug.fsx +++ b/src/NovelIO/Scripts/load-project-debug.fsx @@ -5,6 +5,7 @@ "../Helper.fs" "../Encoding.fs" "../IO.fs" + "../Channels.fs" "../PicklerInfrastructure.fs" "../BinaryPickler.fs" "../File.fs" diff --git a/src/NovelIO/TCP.fs b/src/NovelIO/TCP.fs index fbb5ee1..4747982 100644 --- a/src/NovelIO/TCP.fs +++ b/src/NovelIO/TCP.fs @@ -24,18 +24,40 @@ module Network = /// Type abbreviation for System.Net.IPAddress type IPAddress = System.Net.IPAddress + + + /// Provides functions relating to TCP connections module TCP = - let private acceptConn serv = IO.fromEffectful (fun () -> SideEffectingIO.acceptSocketFromServer serv) + module private SideEffecting = + /// Accept a socket from a TCP Server + let acceptSocketFromServer serv = + {TCPConnectedSocket = serv.TCPListener.AcceptSocket()} + /// 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 + /// Start a TCP server on a supplied ip address and port + let startTCPServer ip port = + let listener = Sockets.TcpListener(ip, port) + listener.Start() + {TCPListener = listener} + + /// Accept a connection from the supplied TCP server + let private acceptConn serv = IO.fromEffectful (fun () -> SideEffecting.acceptSocketFromServer serv) /// Create a TCP server at the specfied IP on the specified port - let createServer ip port = IO.fromEffectful (fun () -> SideEffectingIO.startTCPServer ip port) + let createServer ip port = IO.fromEffectful (fun () -> SideEffecting.startTCPServer ip port) /// Create a TCP server at the specfied IP - let createServerOnFreePort ip = IO.fromEffectful (fun () -> SideEffectingIO.startTCPServer ip 0) + let createServerOnFreePort ip = IO.fromEffectful (fun () -> SideEffecting.startTCPServer ip 0) /// Close a connected socket - let closeConnection socket = IO.fromEffectful (fun () -> SideEffectingIO.closeSocket socket) + let closeConnection socket = IO.fromEffectful (fun () -> SideEffecting.closeSocket socket) /// Accept a connection from the supplied TCP server and handle it with the supplied function let acceptConnection serv f = IO.bracket (acceptConn serv) (closeConnection) (f) @@ -44,7 +66,7 @@ module TCP = let acceptFork serv f = IO.forkIO <| acceptConnection serv f /// Create a TCP connection to the supplied IP and specified port - let connectSocket ip port = IO.fromEffectful (fun () -> SideEffectingIO.connectTCPSocket ip port) + let connectSocket ip port = IO.fromEffectful (fun () -> SideEffecting.connectTCPSocket ip port) /// Retrieves the port the server is listening on let getServerPort server = @@ -52,8 +74,8 @@ module TCP = let ipend = server.TCPListener.Server.LocalEndPoint :?> System.Net.IPEndPoint ipend.Port) - /// Create a handle from a connected socket - let socketToHandle tcpSocket = + /// Create a channel from a connected socket + let socketToTextChannel tcpSocket = IO.return' {TextReader = new StreamReader(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) :> TextReader |> Some; TextWriter = new StreamWriter(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) :> TextWriter |> Some} diff --git a/tests/NovelIO.UnitTests/BinaryTests.fs b/tests/NovelIO.UnitTests/BinaryTests.fs index 31ccc52..29ba3f6 100644 --- a/tests/NovelIO.UnitTests/BinaryTests.fs +++ b/tests/NovelIO.UnitTests/BinaryTests.fs @@ -383,8 +383,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let bytePickler = BinaryPickler.bytePU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr bytePickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr bytePickler bChannel } |> IO.run = byte [] @@ -393,8 +393,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let int16Pickler = BinaryPickler.int16PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr int16Pickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr int16Pickler bChannel } |> IO.run = i16 [] @@ -403,8 +403,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let int32Pickler = BinaryPickler.intPU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr int32Pickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr int32Pickler bChannel } |> IO.run = i32 [] @@ -413,8 +413,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let int32Pickler = BinaryPickler.int64PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr int32Pickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr int32Pickler bChannel } |> IO.run = i64 [] @@ -424,8 +424,8 @@ type ``Incremental Binary Pickler Tests`` = let float32Pickler = BinaryPickler.float32PU let result = io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr float32Pickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr float32Pickler bChannel } |> IO.run match result with |x when System.Single.IsNaN(x) -> System.Single.IsNaN(f32) @@ -438,8 +438,8 @@ type ``Incremental Binary Pickler Tests`` = let float64Pickler = BinaryPickler.floatPU let result = io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr float64Pickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr float64Pickler bChannel } |> IO.run match result with |x when System.Double.IsNaN(x) -> System.Double.IsNaN(f64) @@ -453,8 +453,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let decPickler = BinaryPickler.decimalPU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr decPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr decPickler bChannel } |> IO.run = dec [] @@ -468,8 +468,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.asciiPU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -479,8 +479,8 @@ type ``Incremental Binary Pickler Tests`` = let stringPickler = BinaryPickler.nullTerminated BinaryPickler.asciiCharPU let buff = MemoryBuffer.createFromByteArray bytes io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -494,8 +494,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.utf7PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -509,8 +509,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.utf8PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -525,8 +525,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.LittleEndian.utf16PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -541,8 +541,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.BigEndian.utf16PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -556,8 +556,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.LittleEndian.utf32PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str [] @@ -571,8 +571,8 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createFromByteArray bytes let stringPickler = BinaryPickler.BigEndian.utf32PU io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - return! BinaryPickler.unpickleIncr stringPickler bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + return! BinaryPickler.unpickleIncr stringPickler bChannel } |> IO.run = str @@ -580,40 +580,40 @@ type ``Incremental Binary Pickler Tests`` = static member ``Pickle byte from one byte`` (byte : byte) = let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.bytePU) bHandle byte - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.bytePU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.bytePU) bChannel byte + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.bytePU) bChannel } |> IO.run = byte [] static member ``Pickle int16 from one int16`` (i16 : int16) = let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.int16PU) bHandle i16 - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.int16PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.int16PU) bChannel i16 + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.int16PU) bChannel } |> IO.run = i16 [] static member ``Pickle int from one int`` (i32 : int32) = let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.intPU) bHandle i32 - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.intPU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.intPU) bChannel i32 + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.intPU) bChannel } |> IO.run = i32 [] static member ``Pickle int64 from one int64`` (i64 : int64) = let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.int64PU) bHandle i64 - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.int64PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.int64PU) bChannel i64 + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.int64PU) bChannel } |> IO.run = i64 [] @@ -621,10 +621,10 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createExpandable() let result = io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.floatPU) bHandle f64 - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.floatPU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.floatPU) bChannel f64 + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.floatPU) bChannel } |> IO.run match result with |x when System.Double.IsNaN(x) -> System.Double.IsNaN(f64) @@ -635,10 +635,10 @@ type ``Incremental Binary Pickler Tests`` = let buff = MemoryBuffer.createExpandable() let result = io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.float32PU) bHandle f32 - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.float32PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.float32PU) bChannel f32 + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.float32PU) bChannel } |> IO.run match result with |x when System.Single.IsNaN(x) -> System.Single.IsNaN(f32) @@ -648,10 +648,10 @@ type ``Incremental Binary Pickler Tests`` = static member ``Pickle decimal from one decimal`` (dec : decimal) = let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.decimalPU) bHandle dec - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.decimalPU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.decimalPU) bChannel dec + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.decimalPU) bChannel } |> IO.run = dec [] @@ -659,10 +659,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.asciiPU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.asciiPU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.asciiPU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.asciiPU) bChannel } |> IO.run = str [] @@ -670,10 +670,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.utf7PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.utf7PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.utf7PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.utf7PU) bChannel } |> IO.run = str [] @@ -681,10 +681,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.utf8PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.utf8PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.utf8PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.utf8PU) bChannel } |> IO.run = str [] @@ -692,10 +692,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.utf8BomPU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.utf8BomPU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.utf8BomPU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.utf8BomPU) bChannel } |> IO.run = str [] @@ -703,10 +703,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.LittleEndian.utf16PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.LittleEndian.utf16PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.LittleEndian.utf16PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.LittleEndian.utf16PU) bChannel } |> IO.run = str [] @@ -714,10 +714,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.BigEndian.utf16PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.BigEndian.utf16PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.BigEndian.utf16PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.BigEndian.utf16PU) bChannel } |> IO.run = str [] @@ -725,10 +725,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.utf16PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.utf16PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.utf16PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.utf16PU) bChannel } |> IO.run = str [] @@ -736,10 +736,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.LittleEndian.utf32PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.LittleEndian.utf32PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.LittleEndian.utf32PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.LittleEndian.utf32PU) bChannel } |> IO.run = str [] @@ -747,10 +747,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.BigEndian.utf32PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.BigEndian.utf32PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.BigEndian.utf32PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.BigEndian.utf32PU) bChannel } |> IO.run = str [] @@ -758,10 +758,10 @@ type ``Incremental Binary Pickler Tests`` = let str = nStr.Get let buff = MemoryBuffer.createExpandable() io { - let! bHandle = MemoryBuffer.bufferToBinaryHandle buff - do! BinaryPickler.pickleIncr (BinaryPickler.utf32PU) bHandle str - do! IO.bhSetAbsPosition bHandle 0L - return! BinaryPickler.unpickleIncr (BinaryPickler.utf32PU) bHandle + let! bChannel = MemoryBuffer.bufferToBinaryChannel buff + do! BinaryPickler.pickleIncr (BinaryPickler.utf32PU) bChannel str + do! BinaryChannel.setAbsPosition bChannel 0L + return! BinaryPickler.unpickleIncr (BinaryPickler.utf32PU) bChannel } |> IO.run = str diff --git a/tests/NovelIO.UnitTests/IOTests.fs b/tests/NovelIO.UnitTests/IOTests.fs index 125a4c4..9b14802 100644 --- a/tests/NovelIO.UnitTests/IOTests.fs +++ b/tests/NovelIO.UnitTests/IOTests.fs @@ -21,6 +21,8 @@ open NovelFS.NovelIO.BinaryPickler open FsCheck open FsCheck.Xunit +exception BracketCloseTestException + type ``IO Unit Tests``() = [] static member ``return' of some test data returns the test data when run`` (testData : obj) = @@ -67,16 +69,19 @@ type ``IO Unit Tests``() = let test = IO.mapM (fun _ -> createTestFail) testData true + + [] static member ``bracket calls close action if exception thrown`` () = let create = IO.return' () let mutable called = false let closed = IO.fromEffectful (fun _ -> called <- true) - let expt = IO.fromEffectful (fun _ -> failwith "test exception") + let expt = IO.fromEffectful (fun _ -> raise BracketCloseTestException) try IO.bracket create (fun _ -> closed) (fun _ -> expt) |> IO.run with - exn -> () + | BracketCloseTestException -> () + | exn -> reraise() called = true [] From b65612dbc873839066abaf48ad929dcd1df1f295 Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 10 Jul 2016 16:01:49 +0100 Subject: [PATCH 09/13] Added new functions on channels for end of stream/end of file Added untilM function in IO Seperated IO operators into a seperate module Inlined some primitive functions Parallel IO performance improvements Documentation updates --- NovelIO.sln | 1 + docs/content/channels.fsx | 54 ++++++++++++++++++++++++++++ docs/content/files.fsx | 24 ++++++++++++- docs/tools/templates/template.cshtml | 2 +- src/NovelIO/Channels.fs | 25 +++++++++++-- src/NovelIO/File.fs | 4 +-- src/NovelIO/IO.fs | 44 ++++++++++++++--------- src/NovelIO/MemoryBuffer.fs | 6 ++-- src/NovelIO/Prelude.fs | 14 +++++--- src/NovelIO/TCP.fs | 4 +-- 10 files changed, 146 insertions(+), 32 deletions(-) create mode 100644 docs/content/channels.fsx diff --git a/NovelIO.sln b/NovelIO.sln index 776b7f6..7bbad40 100644 --- a/NovelIO.sln +++ b/NovelIO.sln @@ -25,6 +25,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tools", "tools", "{83F16175 EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "content", "content", "{8E6D5255-776D-4B61-85F9-73C37AA1FB9A}" ProjectSection(SolutionItems) = preProject + docs\content\channels.fsx = docs\content\channels.fsx docs\content\files.fsx = docs\content\files.fsx docs\content\index.fsx = docs\content\index.fsx docs\content\motivation.fsx = docs\content\motivation.fsx diff --git a/docs/content/channels.fsx b/docs/content/channels.fsx new file mode 100644 index 0000000..48ee835 --- /dev/null +++ b/docs/content/channels.fsx @@ -0,0 +1,54 @@ +(*** 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 + +(** +Channels +====================== + +Channels represent a mechanism of one or two way communication with some kind of resource, such as a file or remote server (e.g. via TCP). + +Channels come in two flavours, a `TChannel` which supports text data and a `BChannel` which supports binary data, functions are provided in the `TextChannel` and `BinaryChannel` modules respectively. + +## Controlling lifetime + +The typical method of controlling method of explicitly controlling lifetime in .NET is to use `IDispoable`, however this approach fundamentally relies on side-effects. NovelIO therefore uses a different approach: the bracket pattern. + +`bracket` is a function supplied in the `IO` module: `val bracket : IO<'a> -> ('a -> IO<'b>) -> ('a -> IO<'c>) -> IO<'c>`. + +The first argument is an action of type `IO<'a>` which creates a resource. + +The second argument is a function which takes the resource created by the first action and cleans it up. + +The third argument is a function which takes the resource created by the first action and returns a new action, this new action is then returned by the `bracket` function. + +Put succinctly, there is a way of creating a resource, a way of cleaning it up and a function to happen in between. + +### Using the bracket pattern + +In general, you don't need to worry about using 'bracket' explictly. Functions are created for different resources to avoid you having to fill out all of `bracket`'s arguments manually. + +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 + }) +} + +(** + +By using the `withTextChannel` function, we can supply an argument of the form `TChannel -> IO<'a>` which determines what to do with the channel during its entire lifetime. This is equivalent to just the final argument of `bracket` where the two preceeding arguments are filled in for us. + +`with_` functions are provided throughout the library for other types of channels and resources but they follow the same pattern as described here. + +*) \ No newline at end of file diff --git a/docs/content/files.fsx b/docs/content/files.fsx index 8be7214..63a77ec 100644 --- a/docs/content/files.fsx +++ b/docs/content/files.fsx @@ -39,4 +39,26 @@ The `File` modules contains functions very similar to `System.IO.File` defined i io { let! lines = File.readLines fName return lines -} \ No newline at end of file +} + +(** +## 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)) + } + +(** + +It is recommended that you use that the `withChannel` functions provided so that the channel will be automatically cleaned up after its use rather than explicitly opening and closing channels manually. + +You can find more about channels on the [channels page](channels.html). + +*) \ No newline at end of file diff --git a/docs/tools/templates/template.cshtml b/docs/tools/templates/template.cshtml index 609c29b..7cabda6 100644 --- a/docs/tools/templates/template.cshtml +++ b/docs/tools/templates/template.cshtml @@ -49,7 +49,7 @@
  • From an OOP Perspective
  • Working with Files
  • Using the Pickler Combinator
    • - +
  • Channels
  • Documentation
  • API Reference
    • diff --git a/src/NovelIO/Channels.fs b/src/NovelIO/Channels.fs index ceef383..65a830f 100644 --- a/src/NovelIO/Channels.fs +++ b/src/NovelIO/Channels.fs @@ -50,7 +50,12 @@ module TextChannel = /// Determines whether a supplied text channel is ready to be read from let isChannelReadyToRead channel = match channel.TextReader with - |Some txtRdr -> txtRdr.Peek() = -1 + |Some txtRdr -> txtRdr.Peek() <> -1 + |None -> raise ChannelDoesNotSupportReadingException + /// Determines whether a supplied text channel has reached the end of the stream + let isChannelAtEndOfStream channel = + match channel.TextReader with + |Some txtRdr -> txtRdr.EndOfStream |None -> raise ChannelDoesNotSupportReadingException /// An action that closes a text channel @@ -59,6 +64,12 @@ module TextChannel = /// An action that reads a line from the text channel let getLine 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) + + /// An action that determines if the text channel is at the end of the file. This a synonym for isEOS + let isEOF channel = isEOS channel + /// An action that determines if the text channel has data available let isReady channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelReadyToRead channel) @@ -76,6 +87,11 @@ module BinaryChannel = 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 /// Sets the absolute position of the binary channel let setAbsPosition pos bChannel = match bChannel.BinaryReader with @@ -98,8 +114,8 @@ module BinaryChannel = /// An action that closes a binary channel let close channel = IO.fromEffectful (fun _ -> SideEffecting.close channel) - /// 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 determines if the binary channel has data available + let isReady channel = IO.fromEffectful (fun _ -> SideEffecting.isChannelReadyToRead channel) /// Channel reading partial byte arrays in different ways let private readPartialByteArray channel count f = @@ -119,5 +135,8 @@ module BinaryChannel = |true -> Some bytes |false -> None) + /// 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 diff --git a/src/NovelIO/File.fs b/src/NovelIO/File.fs index 3f9b2ac..44db42b 100644 --- a/src/NovelIO/File.fs +++ b/src/NovelIO/File.fs @@ -33,8 +33,8 @@ module private SideEffectingFileIO = /// Create a file channel for a supplied file name, file mode and file access let openTextFileChannel (fName : Filename) mode access = - let crTxtRdr (fStream : FileStream) = new StreamReader(fStream) :> TextReader - let crTxtWrtr (fStream : FileStream) = new StreamWriter(fStream) :> TextWriter + 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 (reader, writer) = match access with diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 1f98c01..cca4f86 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -59,24 +59,34 @@ module IO = |true -> bind (body) (fun () -> this.While(guard, body)) let private io = IOBuilder() - /// Monadic bind operator for IO actions - let (>>=) x f = bind x f - /// Left to right Kleisli composition of IO actions, allows composition of binding functions - let (>=>) f g x = f x >>= g - /// Right to left Kleisli composition of IO actions, allows composition of binding functions - let (<=<) f g x = flip (>=>) f g x + /// Takes a function which transforms a value to another value and an IO action which produces /// the first value, producing a new IO action which produces the second value - let map f x = x >>= (return' << f) - /// Map operator for IO actions - let () f x = map f x + let map f x = bind x (return' << f) /// Takes an IO action which produces a function that maps from a value to another value and an IO action /// which produces the first value, producing a new IO action which produces the second value. This is like /// map but the mapping function is contained within IO. let apply (f : IO<'a -> 'b>) (x : IO<'a>) = - f >>= (fun fe -> map fe x) - /// Apply operator for IO actions - let (<*>) (f : IO<'a -> 'b>) (x : IO<'a>) = apply f x + bind f (fun fe -> map fe x) + + module Operators = + /// 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 + /// Sequence actions, discarding the value of the second argument. + 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 + let inline (>=>) f g x = f x >>= g + /// Right to left Kleisli composition of IO actions, allows composition of binding functions + let inline (<=<) f g x = flip (>=>) f g x + /// Map operator for IO actions + let inline () f x = map f x + + open Operators + /// Removes a level of IO structure let join x = x >>= id /// Takes a function which transforms two values in another value and two IO actions which produce the first two @@ -197,6 +207,9 @@ module IO = |> List.ofSeq |> Seq.ofList) + /// Execute an action repeatedly until the given boolean IO action returns true + let untilM (pAct : IO) (f : IO<'a>) = whileM (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 = @@ -240,12 +253,11 @@ module IO = member __.Value = value /// Executes the given IO actions in parallel - let par (ios : IO<_> list) = + let par (ios : IO<'a> list) = fromEffectful (fun _ -> ios - |> Seq.map (fun io -> async {return run io}) - |> Async.Parallel - |> Async.RunSynchronously + |> Array.ofList + |> Array.Parallel.map (run) |> List.ofArray) /// Executes the given IO actions in parallel and ignores the result diff --git a/src/NovelIO/MemoryBuffer.fs b/src/NovelIO/MemoryBuffer.fs index 3d551c6..6eb77fd 100644 --- a/src/NovelIO/MemoryBuffer.fs +++ b/src/NovelIO/MemoryBuffer.fs @@ -18,8 +18,10 @@ namespace NovelFS.NovelIO open System.IO +/// A memory buffer that can be read from and written to type MemBuffer = private {MemStream : MemoryStream} +/// Operations on memory buffers module MemoryBuffer = /// Creates an expandable memory buffer with zero initial size let createExpandable() = {MemStream = new MemoryStream()} @@ -30,8 +32,8 @@ module MemoryBuffer = /// Create a channel from a memory buffer let bufferToTextChannel buffer = IO.return' - {TextReader = new StreamReader(buffer.MemStream) :> TextReader |> Some; - TextWriter = new StreamWriter(buffer.MemStream) :> TextWriter |> Some} + {TextReader = new StreamReader(buffer.MemStream) |> Some; + TextWriter = new StreamWriter(buffer.MemStream) |> Some} /// Create a binary channel from a memory buffer let bufferToBinaryChannel buffer = diff --git a/src/NovelIO/Prelude.fs b/src/NovelIO/Prelude.fs index 04c1b30..ba90ea4 100644 --- a/src/NovelIO/Prelude.fs +++ b/src/NovelIO/Prelude.fs @@ -92,12 +92,16 @@ module PathDiscriminators = [] module General = /// Helper function that takes two arguments and throws away the second, returning the first - let const' x _ = x + let inline const' x _ = x /// When supplied with a function f, returns a new function that accepts the first and second arguments in the opposite order - let flip f a b = f b a + let inline flip f a b = f b a /// Curried function for prepending to list, equivalent to x :: ys - let listCons x ys = x :: ys - + let inline listCons x ys = x :: ys + /// Converts an uncurried function to a curried function. + let inline curry f a b = f(a, b) + /// 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 FileMode = @@ -125,7 +129,7 @@ type FileAccess = |ReadWrite /// A channel that may support text being read from it and written to it -type TChannel = private {TextReader : TextReader option; TextWriter : TextWriter option} +type TChannel = private {TextReader : StreamReader option; TextWriter : StreamWriter option} /// A channel that may support binary data being read from it or written to it type BChannel = private {BinaryReader : BinaryReader option; BinaryWriter : BinaryWriter option} diff --git a/src/NovelIO/TCP.fs b/src/NovelIO/TCP.fs index 4747982..a5eb820 100644 --- a/src/NovelIO/TCP.fs +++ b/src/NovelIO/TCP.fs @@ -77,7 +77,7 @@ module TCP = /// Create a channel from a connected socket let socketToTextChannel tcpSocket = IO.return' - {TextReader = new StreamReader(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) :> TextReader |> Some; - TextWriter = new StreamWriter(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) :> TextWriter |> Some} + {TextReader = new StreamReader(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some; + TextWriter = new StreamWriter(new Sockets.NetworkStream(tcpSocket.TCPConnectedSocket)) |> Some} From fbfdb056cf70f24ae1f79cf767aadad8a7faa7c2 Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 10 Jul 2016 16:34:58 +0100 Subject: [PATCH 10/13] Added recursive PU documentation --- docs/content/pickler.fsx | 35 ++++++++++++++++++++++++++++++ src/NovelIO/IO.fs | 1 + tests/NovelIO.UnitTests/IOTests.fs | 2 -- 3 files changed, 36 insertions(+), 2 deletions(-) diff --git a/docs/content/pickler.fsx b/docs/content/pickler.fsx index 32d2cda..90d51f1 100644 --- a/docs/content/pickler.fsx +++ b/docs/content/pickler.fsx @@ -177,6 +177,41 @@ let shapePU = The `alt` combinator is the key to this process. It accepts a function that deconstructs a data type into a simple numeric tag and a `Map` which defines the PU to use internally for each of the cases. +## Encoding Recursive Values + +Since F# is an eagerly evaluated language, we cannot define recursive values as they would never resolve. To avoid this problem, a `RecursivePU` constructor is provided to allow the recursive definition of the PU to be deferred until required. + +A good example of a suitable data type is provided in the paper: + +*) + +type Bookmark = + |URL of string + |Folder of string * Bookmark list + +(** + +We can define a PU for this type by using a mutally recusive value and a function in combination with the `RecursivePU` constructor. + +*) + + +let rec bookmarkPU = RecursivePU bookmarkPURec +and private bookmarkPURec() = + // define a PU for the URL case, this is just a UTF-8 PU with a way of constructing and deconstructing a Bookmark + let urlPU = BinaryPickler.wrap (URL, function URL x -> x) BinaryPickler.utf8PU + // a pickler for the folder case is a tuple2 PU with a UTF-8 PU for the name and a list pickler of bookmarkPU's and a way of constructing + // and deconstructing the Bookmark + let folderPU = BinaryPickler.wrap (Folder, function Folder (st, bms) -> st, bms) (BinaryPickler.tuple2 BinaryPickler.utf8PU (BinaryPickler.list bookmarkPU)) + // define that tag 0 means urlPU and tag 1 means folderPU + let m = Map.ofList [(0, urlPU);(1, folderPU)] + // define that URL should mean use tag 0 and Folder should mean use tag 1 + m |> BinaryPickler.alt (function | URL _ -> 0 | Folder _ -> 1) + +(** + +This approach permits the pickling/unpickling of potentially very complex data types with very little development work required. + ## Incremental Pickling In many cases, especially when dealing with large binary files, it could be desirable to not have to convert back and forth between extremely large byte arrays, indeed this approach might not be viable due to available memory. diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index cca4f86..b80acaa 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -63,6 +63,7 @@ module IO = /// Takes a function which transforms a value to another value and an IO action which produces /// the first value, producing a new IO action which produces the second value let map f x = bind x (return' << f) + /// Takes an IO action which produces a function that maps from a value to another value and an IO action /// which produces the first value, producing a new IO action which produces the second value. This is like /// map but the mapping function is contained within IO. diff --git a/tests/NovelIO.UnitTests/IOTests.fs b/tests/NovelIO.UnitTests/IOTests.fs index 9b14802..580b15d 100644 --- a/tests/NovelIO.UnitTests/IOTests.fs +++ b/tests/NovelIO.UnitTests/IOTests.fs @@ -69,8 +69,6 @@ type ``IO Unit Tests``() = let test = IO.mapM (fun _ -> createTestFail) testData true - - [] static member ``bracket calls close action if exception thrown`` () = let create = IO.return' () From 038f743279863fbd08b7b4d25f12b8ec09dbfa32 Mon Sep 17 00:00:00 2001 From: Phil Date: Sun, 10 Jul 2016 21:24:10 +0100 Subject: [PATCH 11/13] updated IOBuilder for comment updated load project fsx --- src/NovelIO/IO.fs | 2 +- src/NovelIO/Scripts/load-project.fsx | 12 +++++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index b80acaa..4cffec8 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -171,7 +171,7 @@ module IO = let repeatM mFunc n = replicateM mFunc n >>= (return' << ignore) - /// IOBuilder extensions so that traverseM_ can be used to define For + /// IOBuilder extensions so that iterM can be used to define For type IOBuilder with /// Definition of for loops within IO computation expressions member this.For (sequence : seq<_>, body) = diff --git a/src/NovelIO/Scripts/load-project.fsx b/src/NovelIO/Scripts/load-project.fsx index ed2a566..b1e93f5 100644 --- a/src/NovelIO/Scripts/load-project.fsx +++ b/src/NovelIO/Scripts/load-project.fsx @@ -1,8 +1,14 @@ // Warning: generated file; your changes could be lost when a new file is generated. #I __SOURCE_DIRECTORY__ #load @"load-references.fsx" -#load @"..\BinaryParser.fs" - @"..\Definitions.fs" - @"..\IOFormats.fs" +#load @"..\Prelude.fs" + @"..\Helper.fs" + @"..\Encoding.fs" @"..\IO.fs" + @"..\Channels.fs" + @"..\PicklerInfrastructure.fs" + @"..\BinaryPickler.fs" @"..\File.fs" + @"..\TCP.fs" + @"..\Random.fs" + @"..\MemoryBuffer.fs" From 63bee489ec603793b972eafa121ddc88c72c5b5b Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Tue, 12 Jul 2016 00:21:17 +0100 Subject: [PATCH 12/13] Simplified monadic definition of IO Added lift function Seperated out console, datetime and thread modules into Actions.fs --- src/NovelIO/Actions.fs | 42 +++++++++++++ src/NovelIO/IO.fs | 69 +++++++++------------- src/NovelIO/NovelIO.fsproj | 1 + src/NovelIO/Scripts/load-project-debug.fsx | 1 + src/NovelIO/Scripts/load-project.fsx | 1 + 5 files changed, 72 insertions(+), 42 deletions(-) create mode 100644 src/NovelIO/Actions.fs diff --git a/src/NovelIO/Actions.fs b/src/NovelIO/Actions.fs new file mode 100644 index 0000000..18f7edc --- /dev/null +++ b/src/NovelIO/Actions.fs @@ -0,0 +1,42 @@ +(* + 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 + +/// Console functions +module Console = + /// An action that reads a key from the console + let readKey = IO.fromEffectful (fun () -> System.Console.ReadKey()) + /// An action that reads a line from the console + let readLine = IO.fromEffectful (fun () -> System.Console.ReadLine()) + /// An action that writes a line to the console + let writeLine (str : string) = IO.fromEffectful (fun () -> System.Console.WriteLine str) + +/// Threading functions +module Thread = + /// An action that causes the current thread to sleep for a supplied number of milliseconds + let sleep (ms : int) = IO.fromEffectful (fun _ -> System.Threading.Thread.Sleep(ms)) + + /// An action that causes the current thread to yield execution to another thread + let yld = IO.fromEffectful (fun _ -> ignore <| System.Threading.Thread.Yield()) + +/// Provides purely functional Date/Time functions +module DateTime = + /// An aciton that gets the current local time + let localNow = IO.fromEffectful (fun () -> System.DateTime.Now) + /// An aciton that gets the current UTC time + let utcNow = IO.fromEffectful (fun () -> System.DateTime.UtcNow) + diff --git a/src/NovelIO/IO.fs b/src/NovelIO/IO.fs index 4cffec8..bf72113 100644 --- a/src/NovelIO/IO.fs +++ b/src/NovelIO/IO.fs @@ -23,19 +23,31 @@ open System.Net type IO<'a> = private |Return of 'a - |Delay of (unit -> IO<'a>) + |Delay of (unit -> 'a) /// Pure IO Functions module IO = + // ------- RUN ------- // + + /// Runs the IO actions and evaluates the result + let run io = + match io with + |Return a -> a + |Delay (a) -> a() + + // ------- 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 (return' << f) + let fromEffectful f = Delay (f) /// Monadic bind for IO action, this is used to combine and sequence IO actions - let rec bind x f = + let bind x f = match x with |Return a -> f a - |Delay (g) -> Delay (fun _ -> bind (g ()) f) + |Delay (g) -> Delay (fun _ -> run << f <| g()) + /// Removes a level of IO structure + let join x = bind x id /// Computation Expression builder for IO actions type IOBuilder() = @@ -46,7 +58,7 @@ module IO = /// Monadic bind for IO action, this is used to combine and sequence IO action member this.Bind (x : IO<'a>, f : 'a -> IO<'b>) = bind x f /// Delays a function of type unit -> IO<'a> as an IO<'a> - member this.Delay f : IO<'a> = Delay f + member this.Delay f : IO<'a> = f() /// Combine an IO action of type unit an IO action of type 'a into a combined IO action of type 'a member this.Combine(f1, f2) = bind f1 (fun () -> f2) @@ -58,18 +70,28 @@ module IO = |false -> this.Zero() |true -> bind (body) (fun () -> this.While(guard, body)) + // For use within this module, later we need to define this again in an auto-open module let private io = IOBuilder() + // ------- FUNCTOR ------- // + /// Takes a function which transforms a value to another value and an IO action which produces /// the first value, producing a new IO action which produces the second value let map f x = bind x (return' << f) + // ------- APPLICATIVE ------- // + /// Takes an IO action which produces a function that maps from a value to another value and an IO action /// which produces the first value, producing a new IO action which produces the second value. This is like /// map but the mapping function is contained within IO. let apply (f : IO<'a -> 'b>) (x : IO<'a>) = bind f (fun fe -> map fe x) + /// Lift a value. + let pure' x = Return x + + // ------- OPERATORS ------- // + module Operators = /// Apply operator for IO actions let inline (<*>) (f : IO<'a -> 'b>) (x : IO<'a>) = apply f x @@ -88,8 +110,6 @@ module IO = open Operators - /// Removes a level of IO structure - let join x = x >>= id /// Takes a function which transforms two values in another value and two IO actions which produce the first two /// values, producing a new IO action which produces the result of the function application let lift2 f x1 x2 = f x1 <*> x2 @@ -99,17 +119,6 @@ module IO = /// An action that writes a line to console let putStrLn (str : string) = fromEffectful (fun _ -> System.Console.WriteLine str) - // ------- RUN ------- // - - /// Runs the IO actions and evaluates the result - let run io = - let rec runRec (io : IO<'a>) = - match io with - |Return a -> a - |Delay (a) -> runRec <| a() - runRec io - - /// 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 { @@ -286,30 +295,6 @@ module IO = with | :? SuccessException<'b> as ex -> Some <| ex.Value) -/// Console functions -module Console = - /// An action that reads a key from the console - let readKey = IO.fromEffectful (fun () -> System.Console.ReadKey()) - /// An action that reads a line from the console - let readLine = IO.fromEffectful (fun () -> System.Console.ReadLine()) - /// An action that writes a line to the console - let writeLine (str : string) = IO.fromEffectful (fun () -> System.Console.WriteLine str) - -/// Threading functions -module Thread = - /// An action that causes the current thread to sleep for a supplied number of milliseconds - let sleep (ms : int) = IO.fromEffectful (fun _ -> System.Threading.Thread.Sleep(ms)) - - /// An action that causes the current thread to yield execution to another thread - let yld = IO.fromEffectful (fun _ -> ignore <| System.Threading.Thread.Yield()) - -/// Provides purely functional Date/Time functions -module DateTime = - /// An aciton that gets the current local time - let localNow = IO.fromEffectful (fun () -> System.DateTime.Now) - /// An aciton that gets the current UTC time - let utcNow = IO.fromEffectful (fun () -> System.DateTime.UtcNow) - /// Module to provide the definition of the io computation expression [] module IOBuilders = diff --git a/src/NovelIO/NovelIO.fsproj b/src/NovelIO/NovelIO.fsproj index bcaa2a7..337c312 100644 --- a/src/NovelIO/NovelIO.fsproj +++ b/src/NovelIO/NovelIO.fsproj @@ -54,6 +54,7 @@ + diff --git a/src/NovelIO/Scripts/load-project-debug.fsx b/src/NovelIO/Scripts/load-project-debug.fsx index 81539cc..b15be01 100644 --- a/src/NovelIO/Scripts/load-project-debug.fsx +++ b/src/NovelIO/Scripts/load-project-debug.fsx @@ -5,6 +5,7 @@ "../Helper.fs" "../Encoding.fs" "../IO.fs" + "../Actions.fs" "../Channels.fs" "../PicklerInfrastructure.fs" "../BinaryPickler.fs" diff --git a/src/NovelIO/Scripts/load-project.fsx b/src/NovelIO/Scripts/load-project.fsx index b1e93f5..3b69dd0 100644 --- a/src/NovelIO/Scripts/load-project.fsx +++ b/src/NovelIO/Scripts/load-project.fsx @@ -5,6 +5,7 @@ @"..\Helper.fs" @"..\Encoding.fs" @"..\IO.fs" + @"..\Actions.fs" @"..\Channels.fs" @"..\PicklerInfrastructure.fs" @"..\BinaryPickler.fs" From 856bea8ca473e720f8edb834f72def59e50d30e1 Mon Sep 17 00:00:00 2001 From: Phil Curzon Date: Tue, 12 Jul 2016 23:12:48 +0100 Subject: [PATCH 13/13] Updated release notes --- RELEASE_NOTES.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 1524f96..404ef25 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,10 @@ +#### 0.3.0-alpha - 12/07/2016 +Added support for recursive PUs +Renamed Handles to Channels - part of wider API improvements +Added modules containing operations on each Channel type +Made a seperate operators module so that it can be opened independently +Misc performance improvements + #### 0.2.0-alpha - 12/06/2016 Added char PUs for fixed length string encodings Redesigned the naming structure of big endian / little endian PUs to make them easier to work with