Add NameCollisions parameter. Fixes #1.

Author: zanaptak

.editorconfig

@@ -1,8 +1,11 @@
 root = true
 
 [*]
+charset = utf-8
 indent_style = space
 indent_size = 2
-charset = utf-8
 trim_trailing_whitespace = true
 insert_final_newline = true
+
+[*.{sln,fsproj,csproj,vbproj}]
+charset = utf-8-bom

README.md

@@ -101,7 +101,7 @@ The source CSS to process. Can be a file path, web URL, or CSS text.
 * `Naming.CamelCase`: convert to camel case names with all non-alphanumeric characters removed.
 * `Naming.PascalCase`: convert to Pascal case names with all non-alphanumeric characters removed.
 
-If a naming option produces collisions, such as `card-text` and `card_text` both mapping to `CardText` in Pascal case, then the duplicate names will receive `_2`, `_3`, etc. suffixes as needed.
+Note that non-verbatim naming options can produce name collisions. See the [`nameCollisions`](#nameCollisions) parameter for details. 
 
 ### resolutionFolder
 
@@ -137,6 +137,14 @@ let activator = "activator"
 ...
 ```
 
+### nameCollisions
+
+If a naming option produces collisions, such as `card-text` and `card_text` CSS classes both mapping to a `CardText` property in Pascal case, then the duplicate names will be handled according to this option.
+
+- `NameCollisions.BasicSuffix`: (default) The base property name will refer to the closest text match, and additional properties will receive `_2`, `_3`, etc. suffixes as needed. Note that if this option is used during ongoing CSS development, it can cause existing properties to silently change to refer to different classes if collisions are introduced that affect the base name and number determination.
+- `NameCollisions.ExtendedSuffix`: All property names involved in a collision will receive an extended numbered suffix such as `__1_of_2`,  `__2_of_2`. This option is safer for ongoing development since any introduced collision will change all involved names and produce immediate compiler errors where the previous names were used.
+- `NameCollisions.Omit`: All colliding properties will be omitted from the generated type. This option is safer for ongoing development since any introduced collision will remove the original property and produce immediate compiler errors wherever it was used.
+
 ## Notes
 
 As with all type providers, the source CSS file must be available at both design time and build time.

invoke.build.ps1

@@ -1,13 +1,22 @@
-# Install PowerShell for your platform:
+# Install PowerShell Core:
 #   https://docs.microsoft.com/en-us/powershell/scripting/install/installing-powershell
 # Install Invoke-Build:
 #   https://github.com/nightroman/Invoke-Build
 # (Optional) Add "Set-Alias ib Invoke-Build" to your PS profile.
 # At a PS prompt, run any build task (optionally use "ib" alias):
 #   Invoke-Build build
-#   Invoke-Build test
 #   Invoke-Build ?  # this lists available tasks
 
+param (
+  $NuGetApiPushKey = ( property NuGetApiPushKey 'MISSING' ),
+  $LocalPackageDir = ( property LocalPackageDir 'C:\code\LocalPackages' )
+)
+
+$baseProjectName = "TypedCssClasses"
+$basePackageName = "Zanaptak.$baseProjectName"
+
+task . Build
+
 task Clean {
   exec { dotnet clean .\src -c Release }
 }
@@ -24,12 +33,72 @@ task BuildTest {
   exec { dotnet build .\src -c ReleaseTest }
 }
 
+task Test CleanTest, BuildTest, {
+  exec { dotnet test .\test\TypedCssClasses.Tests -c ReleaseTest }
+}
+
 task Pack Clean, Build, {
   exec { dotnet pack .\src -c Release }
 }
 
-task Test CleanTest, BuildTest, {
-  exec { dotnet test .\test\TypedCssClasses.Tests -c ReleaseTest }
+task PackInternal Clean, Build, GetVersion, {
+  $yearStart = Get-Date -Year ( ( Get-Date ).Year ) -Month 1 -Day 1 -Hour 0 -Minute 0 -Second 0 -Millisecond 0
+  $now = Get-Date
+  $buildSuffix = [ int ] ( ( $now - $yearStart ).TotalSeconds )
+  $internalVersion = "$Version.$buildSuffix"
+  exec { dotnet pack .\src -c Release -p:PackageVersion=$internalVersion }
+  $filename = "$basePackageName.$internalVersion.nupkg"
+  Copy-Item .\src\bin\Release\$filename $LocalPackageDir
+  Write-Build Green "Copied $filename to $LocalPackageDir"
 }
 
-task . Build
+task IncrementMinor GetVersion, {
+  if ( $Version -match "^(\d+)\.(\d+)\." ) {
+    $projectFile = "$BuildRoot\src\$baseProjectName.fsproj"
+    $major = $Matches[ 1 ]
+    $minor = $Matches[ 2 ]
+    $newMinor = ( [ int ] $minor ) + 1
+    $newVersion = "$major.$newMinor.0"
+
+    $xml = New-Object System.Xml.XmlDocument
+    $xml.PreserveWhitespace = $true
+    $xml.Load( $projectFile )
+
+    $node = $xml.SelectSingleNode( '/Project/PropertyGroup/Version' )
+    $node.InnerText = $newVersion
+
+    $settings = New-Object System.Xml.XmlWriterSettings
+    $settings.OmitXmlDeclaration = $true
+    $settings.Encoding = New-Object System.Text.UTF8Encoding( $true )
+
+    $writer = [ System.Xml.XmlWriter ]::Create( $projectFile , $settings )
+    try {
+      $xml.Save( $writer )
+    } finally {
+      $writer.Dispose()
+    }
+    Write-Build Green "Updated version to $newVersion"
+  }
+  else {
+    throw "invalid version: $Version"
+  }
+}
+
+task GetVersion {
+  $script:Version = Select-Xml -Path ".\src\$baseProjectName.fsproj" -XPath /Project/PropertyGroup/Version | % { $_.Node.InnerXml.Trim() }
+}
+
+task UploadNuGet EnsureCommitted, GetVersion, {
+  if ( $NuGetApiPushKey -eq "MISSING" ) { throw "NuGet key not provided" }
+  Set-Location ./src/bin/Release
+  $filename = "$basePackageName.$Version.nupkg"
+  if ( -not ( Test-Path $filename ) ) { throw "nupkg file not found" }
+  $lastHour = ( Get-Date ).AddHours( -1 )
+  if ( ( Get-ChildItem $filename ).LastWriteTime -lt $lastHour ) { throw "nupkg file too old" }
+  exec { dotnet nuget push $filename -k $NuGetApiPushKey -s https://api.nuget.org/v3/index.json }
+}
+
+task EnsureCommitted {
+  $gitoutput = exec { git status -s -uall }
+  if ( $gitoutput ) { throw "uncommitted changes exist in working directory" }
+}

src/CssClassesTypeProvider.fs

@@ -8,12 +8,6 @@ open FSharp.Core.CompilerServices
 open System
 open System.Reflection
 
-type Naming =
-  | Verbatim = 0
-  | Underscores = 1
-  | CamelCase = 2
-  | PascalCase = 3
-
 module TypeProvider =
 
   [< TypeProvider >]
@@ -54,17 +48,11 @@ module TypeProvider =
       let naming = args.[ 1 ] :?> Naming
       let resolutionFolder = args.[ 2 ] :?> string
       let getProperties = args.[ 3 ] :?> bool
+      let nameCollisions = args.[ 4 ] :?> NameCollisions
 
       let getSpec _ value =
 
-        let transformer =
-          match naming with
-          | Naming.Underscores -> Utils.symbolsToUnderscores
-          | Naming.CamelCase -> Utils.toCamelCase
-          | Naming.PascalCase -> Utils.toPascalCase
-          | _ -> id
-
-        let cssClasses = Utils.parseCss value transformer
+        let cssClasses = Utils.parseCss value naming nameCollisions
 
         //using ( IO.logTime "TypeGeneration" source ) <| fun _ ->
 
@@ -114,6 +102,7 @@ module TypeProvider =
       ProvidedStaticParameter( "naming" , typeof< Naming >, parameterDefaultValue = Naming.Verbatim )
       ProvidedStaticParameter( "resolutionFolder" , typeof< string >, parameterDefaultValue = "" )
       ProvidedStaticParameter( "getProperties" , typeof< bool >, parameterDefaultValue = false )
+      ProvidedStaticParameter( "nameCollisions" , typeof< NameCollisions >, parameterDefaultValue = NameCollisions.BasicSuffix )
     ]
 
     let helpText = """
@@ -123,6 +112,8 @@ module TypeProvider =
         One of: Naming.Verbatim (default), Naming.Underscores, Naming.CamelCase, Naming.PascalCase.</param>
       <param name='resolutionFolder'>A directory that is used when resolving relative file references.</param>
       <param name='getProperties'>Adds a GetProperties() method that returns a seq of all generated property name/value pairs.</param>
+      <param name='nameCollisions'>Behavior of name collisions that arise from naming strategy.
+        One of: NameCollisions.BasicSuffix (default), NameCollisions.ExtendedSuffix, NameCollisions.Omit. </param>
     """
 
     do parentType.AddXmlDoc helpText

src/TypedCssClasses.fsproj

@@ -1,9 +1,9 @@
-<Project Sdk="Microsoft.NET.Sdk">
+<Project Sdk="Microsoft.NET.Sdk">
 
   <PropertyGroup>
     <TargetFrameworks>netstandard2.0;net452</TargetFrameworks>
     <DisableImplicitSystemValueTupleReference>true</DisableImplicitSystemValueTupleReference>
-    <Version>0.1.0</Version>
+    <Version>0.2.0</Version>
     <PackageId>Zanaptak.TypedCssClasses</PackageId>
     <Authors>zanaptak</Authors>
     <Product>Zanaptak.TypedCssClasses</Product>
@@ -14,6 +14,7 @@
     <PackageProjectUrl>https://github.com/zanaptak/TypedCssClasses</PackageProjectUrl>
     <Configurations>Debug;Release;ReleaseTest;DebugLog</Configurations>
     <RepositoryUrl>https://github.com/zanaptak/TypedCssClasses.git</RepositoryUrl>
+    <RepositoryType>git</RepositoryType>
     <PackageReleaseNotes>https://github.com/zanaptak/TypedCssClasses/releases</PackageReleaseNotes>
   </PropertyGroup>
 
@@ -56,6 +57,7 @@
   </ItemGroup>
 
   <ItemGroup>
+    <Compile Include="Types.fs" />
     <Compile Include="Utils.fs" />
     <Compile Include="CssClassesTypeProvider.fs" />
   </ItemGroup>

src/TypedCssClasses.sln

@@ -7,6 +7,7 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "TypedCssClasses", "TypedCss
 EndProject
 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{CF019DE1-D98F-40B5-A1D4-FC4BE9AC74B6}"
 	ProjectSection(SolutionItems) = preProject
+		..\invoke.build.ps1 = ..\invoke.build.ps1
 		..\README.md = ..\README.md
 	EndProjectSection
 EndProject

src/Types.fs

@@ -0,0 +1,12 @@
+namespace Zanaptak.TypedCssClasses
+
+type Naming =
+  | Verbatim = 0
+  | Underscores = 1
+  | CamelCase = 2
+  | PascalCase = 3
+
+type NameCollisions =
+  | BasicSuffix = 0
+  | ExtendedSuffix = 1
+  | Omit = 2

src/Utils.fs

@@ -4,6 +4,7 @@ open System
 open System.Globalization
 open System.Text.RegularExpressions
 open Zanaptak.TypedCssClasses.Internal.FSharp.Data.Runtime
+open System.Collections.Generic
 
 type Property = { Name : string ; Value : string }
 
@@ -281,35 +282,102 @@ let classNamesFromCss text =
   |> Seq.collect classNamesFromSelectorText
   |> Seq.distinct
 
-let parseCss text transformer =
-  let uniqueName = NameUtils.uniqueGenerator' ()
+let basicSuffixGenerator () =
+  let nameSet = new HashSet<_>()
+  fun ( baseName : string ) ->
+    let mutable name = baseName
+    let mutable trySuffix = 1
+    while nameSet.Contains name do
+      trySuffix <- trySuffix + 1
+      name <- baseName + "_" + string trySuffix
+    nameSet.Add name |> ignore
+    name
+
+type ExtendedSuffixGenerator () =
+  let nameSet = new HashSet<_>()
+
+  member this.Single ( baseName : string ) =
+    let mutable name = baseName
+    let mutable trySuffix = ""
+    while nameSet.Contains name do
+      // shouldn't happen, but just in case
+      if trySuffix = "" then
+        trySuffix <- "__1_of_1"
+      else
+        trySuffix <- "_" + trySuffix
+      name <- baseName + trySuffix
+    nameSet.Add name |> ignore
+    name
+
+  member this.Multiple ( baseName : string ) count =
+    let mutable leadingUnderscores = "__"
+    let digits = ( float count |> Math.Log10 |> int ) + 1
+    let numStr num = ( string num ).PadLeft( digits , '0' )
+    let nameArray underscores = Array.init count ( fun i -> sprintf "%s%s%s_of_%s" baseName underscores ( numStr ( i + 1 ) ) ( numStr count ) )
+    let mutable names = nameArray leadingUnderscores
+    while names |> Array.exists ( fun name -> nameSet.Contains name ) do
+      // If any in a group match an existing name, try again with additional underscore
+      leadingUnderscores <- leadingUnderscores + "_"
+      names <- nameArray leadingUnderscores
+    names |> Array.iter ( fun name -> nameSet.Add name |> ignore )
+    names
+
+let parseCss text naming nameCollisions =
+
+  let transformer =
+    match naming with
+    | Naming.Underscores -> symbolsToUnderscores
+    | Naming.CamelCase -> toCamelCase
+    | Naming.PascalCase -> toPascalCase
+    | _ -> id
 
   let initialProperties =
     text
     |> classNamesFromCss
-    |> Seq.map ( fun s ->
-      { Name = transformer s ; Value = s }
-    )
+    |> Seq.map ( fun s -> { Name = transformer s ; Value = s } )
     |> Seq.filter ( fun p -> not ( p.Name.Contains( "``" ) ) ) // impossible to represent as verbatim property name, user will have to use string value
+    |> Seq.toArray
 
-  let sameNames , differentNames = initialProperties |> Seq.toArray |> Array.partition ( fun p -> p.Name = p.Value )
+  match nameCollisions with
 
-  // A name that exactly matches raw value is exempt from conflict resolution, reserve unique name immediately.
-  // register unique base names in case later suffixed name conflicts
-  // e.g. xyz_2 followed by group of xyz, xyz, xyz, they need to know xyz_2 is already reserved
-  let sameNamesFinal = sameNames |> Array.map ( fun p -> { p with Name = uniqueName p.Name } )
+  | NameCollisions.Omit ->
+    initialProperties
+    |> Array.groupBy ( fun p -> p.Name )
+    |> Array.filter ( fun ( _ , props ) -> props.Length = 1 )
+    |> Array.collect snd
 
-  let differentNamesFinal =
-    differentNames
+  | NameCollisions.ExtendedSuffix ->
+    let nameGen = ExtendedSuffixGenerator()
+    initialProperties
     |> Array.groupBy ( fun p -> p.Name )
+    |> Array.sortBy ( fun ( propName , props ) -> props.Length , propName )
     |> Array.collect ( fun ( propName , props ) ->
       if Array.length props = 1 then
-        [| { props.[ 0 ] with Name = uniqueName propName } |]
+        [| { props.[ 0 ] with Name = nameGen.Single propName } |]
       else
-        // entries with same property name, closest to underying text value gets first chance at unique base name, others get numbered suffix
-        props
-        |> Array.sortBy ( fun p -> levenshtein propName p.Value , p.Value )
-        |> Array.map ( fun p -> { p with Name = uniqueName propName } )
+        let sorted = props |> Array.sortBy ( fun p -> levenshtein propName p.Value , p.Value )
+        let names = nameGen.Multiple propName props.Length
+        Array.zip sorted names
+        |> Array.map ( fun ( p , name ) -> { p with Name = name } )
     )
 
-  Seq.append sameNamesFinal differentNamesFinal
+  | _ ->
+    let nameGen = basicSuffixGenerator ()
+    // A name that exactly matches raw value is exempt from conflict resolution, reserve unique name immediately.
+    // register unique base names in case later suffixed name conflicts
+    // e.g. xyz_2 followed by group of xyz, xyz, xyz, they need to know xyz_2 is already reserved
+    let sameNames , differentNames = initialProperties |> Array.partition ( fun p -> p.Name = p.Value )
+    let sameNamesFinal = sameNames |> Array.map ( fun p -> { p with Name = nameGen p.Name } )
+    let differentNamesFinal =
+      differentNames
+      |> Array.groupBy ( fun p -> p.Name )
+      |> Array.collect ( fun ( propName , props ) ->
+        if Array.length props = 1 then
+          [| { props.[ 0 ] with Name = nameGen propName } |]
+        else
+          // entries with same property name, closest to underying text value gets first chance at unique base name, others get numbered suffix
+          props
+          |> Array.sortBy ( fun p -> levenshtein propName p.Value , p.Value )
+          |> Array.map ( fun p -> { p with Name = nameGen propName } )
+      )
+    Array.append sameNamesFinal differentNamesFinal

src/vendor/FSharp.Data/NameUtils.fs

@@ -98,17 +98,6 @@ let uniqueGenerator (niceName:string->string) =
     set.Add name |> ignore
     name
 
-let uniqueGenerator' () =
-  let set = new HashSet<_>()
-  fun ( baseName : string ) ->
-    let mutable name = baseName
-    let mutable trySuffix = 1
-    while set.Contains name do
-      trySuffix <- trySuffix + 1
-      name <- baseName + "_" + string trySuffix
-    set.Add name |> ignore
-    name
-
 let capitalizeFirstLetter (s:string) =
     match s.Length with
         | 0 -> ""

test/TestWithFable/src/App.fsproj

@@ -1,4 +1,4 @@
-<Project Sdk="Microsoft.NET.Sdk">
+<Project Sdk="Microsoft.NET.Sdk">
   <PropertyGroup>
     <TargetFramework>netstandard2.0</TargetFramework>
   </PropertyGroup>
@@ -15,4 +15,4 @@
       <HintPath>..\..\..\src\bin\DebugLog\netstandard2.0\Zanaptak.TypedCssClasses.dll</HintPath>
     </Reference>
   </ItemGroup>
-</Project>
+</Project>