diff --git a/Directory.Build.props b/Directory.Build.props index 8f5a213..55ed40f 100644 --- a/Directory.Build.props +++ b/Directory.Build.props @@ -13,19 +13,11 @@ embedded - - + + - - - - - Z:\CheckoutRoot\TeqCrate\ - - - + + true + diff --git a/Examples/CsvParser.fsx b/Examples/CsvParser.fsx deleted file mode 100644 index 3b5ac18..0000000 --- a/Examples/CsvParser.fsx +++ /dev/null @@ -1,49 +0,0 @@ -// Note: run 'dotnet publish' in the root of this repo to ensure that the dlls referenced in this script are present - -#r "netstandard" -#I @"..\ShapeSifter\bin\Debug\netstandard2.0\publish" -#r "TypeEquality.dll" -#r "HCollections.dll" -#r "ShapeSifter.dll" - -open HCollections -open System -open System.IO -open TeqCrate -open TeqCrate.Patterns -open TypeEquality - -let parseCell<'a> : string -> 'a = - match tType<'a> with - | String (teq : Teq<'a, string>) -> Teq.castFrom teq - | Bool (teq : Teq<'a, bool>) -> Boolean.Parse >> Teq.castFrom teq - | Int (teq : Teq<'a, int>) -> Int32.Parse >> Teq.castFrom teq - | Float (teq : Teq<'a, float>) -> Double.Parse >> Teq.castFrom teq - | DateTime (teq : Teq<'a, DateTime>) -> DateTime.Parse >> Teq.castFrom teq - | _ -> failwithf "Error - the type %s is not supported" (typeof<'a>.FullName) - -let rec parseRow<'ts> (ts : 'ts TypeList) (cells : string list) : 'ts HList = - match TypeList.split ts with - | Choice1Of2 (teq : Teq<'ts, unit>) -> HList.empty |> Teq.castFrom (HList.cong teq) - | Choice2Of2 crate -> - - crate.Apply - { new TypeListConsEvaluator<_, _> with - member __.Eval (us : 'us TypeList) (teq : Teq<'ts, 'u -> 'us>) = - let head = cells |> List.head |> parseCell<'u> - let tail = cells |> List.tail |> parseRow us - - HList.cons head tail |> Teq.castFrom (HList.cong teq) - } - -let tryParse<'record> (fileInfo : FileInfo) : 'record seq option = - match tType<'record> with - | Record crate -> - crate.Apply - { new RecordConvEvaluator<_, _> with - member __.Eval _ (ts : 'ts TypeList) (conv : Conv<'record, 'ts HList>) = - File.ReadLines fileInfo.FullName - |> Seq.map (fun row -> row.Split ',' |> List.ofArray |> parseRow ts |> conv.From) - |> Some - } - | _ -> None diff --git a/Examples/ExampleParse.fsx b/Examples/ExampleParse.fsx deleted file mode 100644 index ea52ed6..0000000 --- a/Examples/ExampleParse.fsx +++ /dev/null @@ -1,21 +0,0 @@ -// Note: run 'dotnet publish' in the root of this repo to ensure that the dlls referenced in this script are present - -#load "CsvParser.fsx" - -open System -open System.IO - -type MyRecord = - { - Id : int - Name : string - DateOfBirth : DateTime - NewUser : bool - Balance : float - } - -Path.Combine (__SOURCE_DIRECTORY__, "TestData.csv") -|> FileInfo -|> CsvParser.tryParse -|> Option.get -|> Seq.iter (printfn "%A") diff --git a/Examples/SimpleExamples.fsx b/Examples/SimpleExamples.fsx deleted file mode 100644 index 50e1b5b..0000000 --- a/Examples/SimpleExamples.fsx +++ /dev/null @@ -1,163 +0,0 @@ -// Note: run 'dotnet publish' in the root of this repo to ensure that the dlls referenced in this script are present - -#r "netstandard" -#I @"..\ShapeSifter\bin\Debug\netstandard2.0\publish" -#r "TypeEquality.dll" -#r "HCollections.dll" -#r "ShapeSifter.dll" - -open HCollections -open TeqCrate -open TeqCrate.Patterns -open TypeEquality - - - -// Simple Example - -let tryString (a : 'a) : string option = - match tType<'a> with - | String (teq : Teq<'a, string>) -> Teq.castTo teq a |> Some - | _ -> None - -tryString 1234 -tryString "hello" - - - -// List Example - -let tryListLength (a : 'a) : int option = - match tType<'a> with - | List crate -> - crate.Apply - { new ListTeqEvaluator<_, _> with - member __.Eval (teq : Teq<'a, 'b list>) = - a |> Teq.castTo teq |> List.length |> Some - } - | _ -> None - -tryListLength "hello" -tryListLength [ 'a' .. 'z' ] - - - -// List Example 2 - -let tryListSomeCount (a : 'a) : int option = - match tType<'a> with - | List crate -> - crate.Apply - { new ListTeqEvaluator<_, _> with - member __.Eval (teq1 : Teq<'a, 'b list>) = - match tType<'b> with - | Option crate -> - crate.Apply - { new OptionTeqEvaluator<_, _> with - member __.Eval (teq2 : Teq<'b, 'c option>) = - let teq : Teq<'a, 'c option list> = Teq.transitivity teq1 (Teq.Cong.list teq2) - let xs : 'c option list = Teq.castTo teq a - - xs |> List.filter Option.isSome |> List.length |> Some - } - | _ -> None - } - | _ -> None - -tryListSomeCount [ None ; Some 'a' ; None ; Some 'b' ; Some 'c' ] - - - -// Tuple Example - -let tryTupleLength (a : 'a) : int option = - match tType<'a> with - | Tuple crate -> - crate.Apply - { new TupleConvEvaluator<_, _> with - member __.Eval (ts : 'ts TypeList) (conv : Conv<'a, 'ts HList>) = a |> conv.To |> HList.length |> Some - } - | _ -> None - -tryTupleLength ("hello", false) -tryTupleLength (5, 5, 5, 5) - - - -// Tuple Example 2 - -let trySumTupleInts (a : 'a) : int option = - match tType<'a> with - | Tuple crate -> - crate.Apply - { new TupleConvEvaluator<_, _> with - member __.Eval _ (conv : Conv<'a, 'ts HList>) = - let xs : 'ts HList = a |> conv.To - - let folder = - { new HListFolder with - member __.Folder sum (x : 'b) = - match tType<'b> with - | Int teq -> sum + (x |> Teq.castTo teq) - | _ -> sum - } - - HList.fold folder 0 xs |> Some - } - | _ -> None - -trySumTupleInts (5, 5, 5, 5) -trySumTupleInts (5, false, 3, "hello") -trySumTupleInts ("hello", false) - - -// Record Example - -let rec shoutify<'ts> (xs : 'ts HList) : 'ts HList = - match xs |> HList.toTypeList |> TypeList.split with - | Choice1Of2 _ -> xs - | Choice2Of2 crate -> - - crate.Apply - { new TypeListConsEvaluator<_, _> with - member __.Eval _ (teq : Teq<'ts, 'u -> 'us>) = - let xs : ('u -> 'us) HList = xs |> Teq.castTo (HList.cong teq) - - let head = - match tType<'u> with - | String teq -> (xs |> HList.head |> Teq.castTo teq).ToUpper () |> Teq.castFrom teq - | _ -> xs |> HList.head - - let tail = xs |> HList.tail |> shoutify - - HList.cons head tail |> Teq.castFrom (HList.cong teq) - } - -let tryShoutifyRecord (a : 'a) : 'a option = - match tType<'a> with - | Record crate -> - crate.Apply - { new RecordConvEvaluator<_, _> with - member __.Eval _ _ (conv : Conv<'a, 'ts HList>) = - let xs : 'ts HList = a |> conv.To - shoutify xs |> conv.From |> Some - } - | _ -> None - -type MyRecord = - { - FirstName : string - LastName : string - Age : int - Location : string - } - -let sample = - { - FirstName = "Bob" - LastName = "Sample" - Age = 35 - Location = "London" - } - -tryShoutifyRecord sample diff --git a/README.md b/README.md index e9b730e..6baabe6 100644 --- a/README.md +++ b/README.md @@ -2,9 +2,56 @@ Type-safe datatype-generic programming for F#. -## Examples +## Getting started -See the [Examples](./Examples) folder for examples demonstrating how to perform type-safe manipulation of various different types. +The most useful place to start is likely with the `tType<'a>` function and corresponding active patterns in the `Patterns` module. +These patterns reflectively determine what type `'a` was, and give you evidence in the form of a `Teq` (see [TypeEquality](https://github.com/G-Research/TypeEquality)). +Where appropriate, you also get a type-safe representation of the type's structure. + +Here is a brief example. +Everything written here was forced by the types: once we chose to match on the `Unit` and `Record` active patterns, there was only one way to write this function so that it compiled. + +```fsharp +open ShapeSifter +open ShapeSifter.Patterns + +let manipulateType<'a> () = + match tType<'a> with + | Unit teq -> + printfn "'a was a unit type, and `teq` witnesses this!" + | Record data -> + { new RecordConvEvaluator<_> with + member _.Eval (fieldData : RecordTypeField list) (fieldTypes : TypeList<'ts>) (conv : Conv<'a, 'ts HList>) = + failwith "manipulate the type here" + } + |> data.Apply + | _ -> failwith "unrecognised type" +``` + +Inside the `RecordConvEvaluator`, we have gained access to: + +* The list `fieldData` of record fields, telling us the name of each field and any attributes that were on the field (as well as the raw `PropertyInfo` associated with each field). +* The same list of field types, but expressed as a [`HeterogeneousCollections.TypeList`](https://github.com/G-Research/HeterogeneousCollections/blob/main/HeterogeneousCollections/TypeList.fsi). +* A `Conv` (converter) which lets us interchange between an `'a` and a heterogeneous list of its field values. + +We have now seen a pattern for a primitive type (`Unit`) and for an arbitrary record. +Using the patterns in ShapeSifter, we can recognise the following types: + +* Many primitive types, and `DateTime` and `TimeSpan` +* `Array<_>`, `_ list`, `Seq<_>`, `Set<_>` +* `Option<_>` +* `Map<_, _>` +* `_ * _`, `_ * _ * _`, and arbitrary tuples +* `_ -> _` +* `Dictionary<_,_>`, `ResizeArray<_>` +* `Teq<_, _>` +* Records and unions +* "Sums of products" (that is, unions, but where we give you easier access to the products which make up the union fields). + +## More examples + +See the [tests](./ShapeSifter.Test) for examples demonstrating how to perform type-safe manipulation of various different types. +There is a [whistlestop tour](./ShapeSifter.Test/TestExamples.fs) and a [specific example of type-safe CSV parsing](./ShapeSifter.Test/CsvExample). ## Credits diff --git a/ShapeSifter.Test/CsvExample/CsvParser.fs b/ShapeSifter.Test/CsvExample/CsvParser.fs new file mode 100644 index 0000000..f518634 --- /dev/null +++ b/ShapeSifter.Test/CsvExample/CsvParser.fs @@ -0,0 +1,48 @@ +namespace CsvParser + +open HCollections +open System +open ShapeSifter +open ShapeSifter.Patterns +open TypeEquality + +[] +module CsvParser = + let parseCell<'a> : string -> 'a = + match tType<'a> with + | String (teq : Teq<'a, string>) -> Teq.castFrom teq + | Bool (teq : Teq<'a, bool>) -> Boolean.Parse >> Teq.castFrom teq + | Int (teq : Teq<'a, int>) -> Int32.Parse >> Teq.castFrom teq + | Float (teq : Teq<'a, float>) -> Double.Parse >> Teq.castFrom teq + | DateTime (teq : Teq<'a, DateTime>) -> DateTime.Parse >> Teq.castFrom teq + | _ -> failwithf "Error - the type %s is not supported" typeof<'a>.FullName + + let rec parseRow<'ts> (ts : 'ts TypeList) (cells : string list) : 'ts HList = + match TypeList.split ts with + | Choice1Of2 (teq : Teq<'ts, unit>) -> HList.empty |> Teq.castFrom (HList.cong teq) + | Choice2Of2 crate -> + + crate.Apply + { new TypeListConsEvaluator<_, _> with + member _.Eval (us : 'us TypeList) (teq : Teq<'ts, 'u -> 'us>) = + let head = cells |> List.head |> parseCell<'u> + let tail = cells |> List.tail |> parseRow us + + HList.cons head tail |> Teq.castFrom (HList.cong teq) + } + + let tryParse<'record> (data : string seq) : 'record seq option = + match tType<'record> with + | Record crate -> + crate.Apply + { new RecordConvEvaluator<_, _> with + member _.Eval + (fields : RecordTypeField list) + (ts : 'ts TypeList) + (conv : Conv<'record, 'ts HList>) + = + data + |> Seq.map (fun row -> row.Split ',' |> List.ofArray |> parseRow ts |> conv.From) + |> Some + } + | _ -> None diff --git a/ShapeSifter.Test/CsvExample/TestCsvParser.fs b/ShapeSifter.Test/CsvExample/TestCsvParser.fs new file mode 100644 index 0000000..20de713 --- /dev/null +++ b/ShapeSifter.Test/CsvExample/TestCsvParser.fs @@ -0,0 +1,64 @@ +namespace ShapeSifter.Test + +open System +open System.IO +open System.Reflection +open NUnit.Framework +open FsUnitTyped + +open CsvParser + +[] +type MyRecord = + { + Id : int + Name : string + DateOfBirth : DateTime + NewUser : bool + Balance : float + } + +[] +module TestCsvParser = + let getTestData () : string seq = + let assembly = Assembly.GetExecutingAssembly () + + seq { + use stream = + assembly.GetManifestResourceNames () + |> Seq.filter (fun name -> name.EndsWith ("TestData.csv", StringComparison.Ordinal)) + |> Seq.exactlyOne + |> assembly.GetManifestResourceStream + + use reader = new StreamReader (stream) + let mutable isDone = false + + while not isDone do + let line = reader.ReadLine () + if isNull line then isDone <- true else yield line + } + + [] + let ``Example parse`` () = + let actual = + getTestData () |> CsvParser.tryParse |> Option.get |> Seq.toList + + let expected = + [ + { + Id = 1 + Name = "Derry Williamson" + DateOfBirth = DateTime (1974, 03, 12) + NewUser = true + Balance = 12.34 + } + { + Id = 2 + Name = "Madelyn Milne" + DateOfBirth = DateTime (1988, 11, 23) + NewUser = false + Balance = 56.78 + } + ] + + actual |> shouldEqual expected diff --git a/Examples/TestData.csv b/ShapeSifter.Test/CsvExample/TestData.csv similarity index 51% rename from Examples/TestData.csv rename to ShapeSifter.Test/CsvExample/TestData.csv index cceb66f..7ae5b30 100644 --- a/Examples/TestData.csv +++ b/ShapeSifter.Test/CsvExample/TestData.csv @@ -1,2 +1,2 @@ 001,Derry Williamson,1974-03-12,true,12.34 -002,Madelyn Milne,1988-11-23,false,56.78 \ No newline at end of file +002,Madelyn Milne,1988-11-23,false,56.78 diff --git a/ShapeSifter.Test/ShapeSifter.Test.fsproj b/ShapeSifter.Test/ShapeSifter.Test.fsproj index 1481222..9fd0b7a 100644 --- a/ShapeSifter.Test/ShapeSifter.Test.fsproj +++ b/ShapeSifter.Test/ShapeSifter.Test.fsproj @@ -28,4 +28,14 @@ + + + + + + + + + + diff --git a/ShapeSifter.Test/TestExamples.fs b/ShapeSifter.Test/TestExamples.fs new file mode 100644 index 0000000..da1d5ac --- /dev/null +++ b/ShapeSifter.Test/TestExamples.fs @@ -0,0 +1,162 @@ +namespace ShapeSifter.Test + +open NUnit.Framework +open HCollections +open ShapeSifter +open ShapeSifter.Patterns +open TypeEquality +open FsUnitTyped + +[] +module TestExamples = + + [] + let ``Simple example`` () = + let tryString (a : 'a) : string option = + match tType<'a> with + | String (teq : Teq<'a, string>) -> Teq.castTo teq a |> Some + | _ -> None + + tryString 1234 |> shouldEqual None + tryString "hello" |> shouldEqual (Some "hello") + + [] + let ``List example 1`` () = + let tryListLength (a : 'a) : int option = + match tType<'a> with + | List crate -> + { new ListTeqEvaluator<_, _> with + member _.Eval (teq : Teq<'a, 'b list>) = + a |> Teq.castTo teq |> List.length |> Some + } + |> crate.Apply + | _ -> None + + tryListLength "hello" |> shouldEqual None + tryListLength [ 'a' .. 'z' ] |> shouldEqual (Some 26) + + [] + let ``List example 2`` () = + let tryListSomeCount (a : 'a) : int option = + match tType<'a> with + | List crate -> + { new ListTeqEvaluator<_, _> with + member _.Eval (teq1 : Teq<'a, 'b list>) = + match tType<'b> with + | Option crate -> + { new OptionTeqEvaluator<_, _> with + member _.Eval (teq2 : Teq<'b, 'c option>) = + let teq : Teq<'a, 'c option list> = Teq.transitivity teq1 (Teq.Cong.list teq2) + + let xs : 'c option list = Teq.castTo teq a + + xs |> List.filter Option.isSome |> List.length |> Some + } + |> crate.Apply + | _ -> None + } + |> crate.Apply + | _ -> None + + tryListSomeCount [ None ; Some 'a' ; None ; Some 'b' ; Some 'c' ] + |> shouldEqual (Some 3) + + [] + let ``Tuple example 1`` () = + let tryTupleLength (a : 'a) : int option = + match tType<'a> with + | Tuple crate -> + { new TupleConvEvaluator<_, _> with + member _.Eval (ts : 'ts TypeList) (conv : Conv<'a, 'ts HList>) = + a |> conv.To |> HList.length |> Some + } + |> crate.Apply + | _ -> None + + tryTupleLength ("hello", false) |> shouldEqual (Some 2) + tryTupleLength (5, 5, 5, 5) |> shouldEqual (Some 4) + + [] + let ``Tuple example 2`` () = + let trySumTupleInts (a : 'a) : int option = + match tType<'a> with + | Tuple crate -> + { new TupleConvEvaluator<_, _> with + member _.Eval _ (conv : Conv<'a, 'ts HList>) = + let xs : 'ts HList = a |> conv.To + + let folder = + { new HListFolder with + member _.Folder sum (x : 'b) = + match tType<'b> with + | Int teq -> sum + (x |> Teq.castTo teq) + | _ -> sum + } + + HList.fold folder 0 xs |> Some + } + |> crate.Apply + | _ -> None + + trySumTupleInts (5, 5, 5, 5) |> shouldEqual (Some 20) + trySumTupleInts (5, false, 3, "hello") |> shouldEqual (Some 8) + trySumTupleInts ("hello", false) |> shouldEqual (Some 0) + + let rec shoutify<'ts> (xs : 'ts HList) : 'ts HList = + match xs |> HList.toTypeList |> TypeList.split with + | Choice1Of2 _ -> xs + | Choice2Of2 crate -> + + { new TypeListConsEvaluator<_, _> with + member _.Eval _ (teq : Teq<'ts, 'u -> 'us>) = + let xs : ('u -> 'us) HList = xs |> Teq.castTo (HList.cong teq) + + let head = + match tType<'u> with + | String teq -> (xs |> HList.head |> Teq.castTo teq).ToUpper () |> Teq.castFrom teq + | _ -> xs |> HList.head + + let tail = xs |> HList.tail |> shoutify + + HList.cons head tail |> Teq.castFrom (HList.cong teq) + } + |> crate.Apply + + let tryShoutifyRecord (a : 'a) : 'a option = + match tType<'a> with + | Record crate -> + { new RecordConvEvaluator<_, _> with + member _.Eval _ _ (conv : Conv<'a, 'ts HList>) = + let xs : 'ts HList = a |> conv.To + shoutify xs |> conv.From |> Some + } + |> crate.Apply + | _ -> None + + type MyRecord = + { + FirstName : string + LastName : string + Age : int + Location : string + } + + [] + let ``Record example`` () = + let sample = + { + FirstName = "Bob" + LastName = "Sample" + Age = 35 + Location = "London" + } + + let expected = + { + FirstName = "BOB" + LastName = "SAMPLE" + Age = 35 + Location = "LONDON" + } + + tryShoutifyRecord sample |> shouldEqual (Some expected) diff --git a/ShapeSifter/Patterns.fs b/ShapeSifter/Patterns.fs index 400ca3b..f1fbafd 100644 --- a/ShapeSifter/Patterns.fs +++ b/ShapeSifter/Patterns.fs @@ -1,4 +1,4 @@ -namespace ShapeSifter +namespace ShapeSifter open System open TypeEquality @@ -7,6 +7,7 @@ module Patterns = type 'a TType = | TType of unit + [] let tType<'a> : 'a TType = TType () let (|Bool|_|) (_ : 'a TType) : Teq<'a, bool> option = Teq.tryRefl<'a, bool> diff --git a/ShapeSifter/Patterns.fsi b/ShapeSifter/Patterns.fsi index db8849d..a655b11 100644 --- a/ShapeSifter/Patterns.fsi +++ b/ShapeSifter/Patterns.fsi @@ -17,6 +17,7 @@ module Patterns = /// Single constructor for TType - creates a TType value of 'a when invoked with any generic /// type parameter 'a + [] val tType<'a> : 'a TType /// Recognises tTypes that represent the bool type. diff --git a/ShapeSifter/ShapeSifter.fsproj b/ShapeSifter/ShapeSifter.fsproj index 37f67e2..74fe6b6 100644 --- a/ShapeSifter/ShapeSifter.fsproj +++ b/ShapeSifter/ShapeSifter.fsproj @@ -2,15 +2,16 @@ netstandard2.0 - 5 - true - - Nicholas Cowle - TeqCrate - TeqCrate is a type-safe datatype-generic programming library for F#. It offers a type-safe and extensible way to inspect, decompose and create values for various kinds of common F# and .NET types. - https://github.com/nickcowle/TeqCrate + true + ShapeSifter + G-Research + ShapeSifter is a type-safe datatype-generic programming library for F#. It offers a type-safe and extensible way to inspect, decompose and create values for various kinds of common F# and .NET types. + Copyright (c) G-Research 2024 + README.md + https://github.com/G-Research/ShapeSifter + git MIT - datatype generic type safe heterogeneous collection collections f# product sum data types equality + datatype;generic;typesafe;f#;product;sum @@ -39,11 +40,12 @@ + - +