diff --git a/ihp/IHP/NameSupport.hs b/ihp/IHP/NameSupport.hs index 3f38041c3..5f65b9877 100644 --- a/ihp/IHP/NameSupport.hs +++ b/ihp/IHP/NameSupport.hs @@ -125,10 +125,61 @@ modelNameToTableName modelName = -- -- >>> columnNameToFieldName "project_id" -- "projectId" +-- +-- >>> columnNameToFieldName "foo_25bar" +-- "foo25bar" columnNameToFieldName :: Text -> Text -columnNameToFieldName columnName = escapeHaskellKeyword (unwrapEither columnName $ Inflector.toCamelCased False columnName) +columnNameToFieldName columnName = escapeHaskellKeyword (columnNameToFieldName' columnName) {-# INLINABLE columnNameToFieldName #-} +-- Internal implementation that handles numbers after underscores correctly +columnNameToFieldName' :: Text -> Text +columnNameToFieldName' columnName + | Text.null columnName = columnName + | hasNumberAfterUnderscore columnName = customCamelCase columnName + | otherwise = unwrapEither columnName $ Inflector.toCamelCased False columnName + where + -- Check if there's a pattern like "_\d" (underscore followed by digit) + hasNumberAfterUnderscore text = + not (Text.null text) && "_" `Text.isInfixOf` text && any isDigitAfterUnderscore (Text.zip text (Text.drop 1 text)) + isDigitAfterUnderscore ('_', c) = Char.isDigit c + isDigitAfterUnderscore _ = False + + -- Custom camel case: split at digit-letter boundaries carefully + customCamelCase text = + text + |> Text.split (== '_') + |> processSegments 0 + |> mconcat + where + processSegments :: Int -> [Text] -> [Text] + processSegments _ [] = [] + processSegments idx (segment:rest) + | Text.null segment = processSegments idx rest + | Char.isDigit (Text.head segment) = + -- Digit-only segment (e.g., "123" from "test_123_column") + -- Keep as-is, don't increment word count + if Text.all Char.isDigit segment + then segment : processSegments idx rest + else + -- Mixed segment (e.g., "25bar" from "foo_25bar") + -- Keep lowercase to indicate they're joined + lcfirstSegment segment : processSegments (idx+1) rest + | idx == 0 = + -- First word segment: lowercase + lcfirstSegment segment : processSegments (idx+1) rest + | otherwise = + -- Other word segments: capitalize + ucfirstSegment segment : processSegments (idx+1) rest + + lcfirstSegment seg + | Text.null seg = seg + | otherwise = Text.toLower (Text.take 1 seg) <> Text.drop 1 seg + + ucfirstSegment seg + | Text.null seg = seg + | otherwise = Text.toUpper (Text.take 1 seg) <> Text.drop 1 seg + {-# INLINABLE unwrapEither #-} unwrapEither _ (Right value) = value unwrapEither input (Left value) = error ("IHP.NameSupport: " <> show value <> " (value to be transformed: " <> show input <> ")") @@ -140,10 +191,43 @@ unwrapEither input (Left value) = error ("IHP.NameSupport: " <> show value <> " -- -- >>> fieldNameToColumnName "projectId" -- "project_id" +-- +-- >>> fieldNameToColumnName "foo25bar" +-- "foo_25bar" fieldNameToColumnName :: Text -> Text -fieldNameToColumnName columnName = unwrapEither columnName $ Inflector.toUnderscore columnName +fieldNameToColumnName fieldName = fieldNameToColumnName' fieldName {-# INLINABLE fieldNameToColumnName #-} +-- Internal implementation that handles numbers correctly to ensure round-trip +fieldNameToColumnName' :: Text -> Text +fieldNameToColumnName' fieldName + | Text.null fieldName = fieldName + | Text.any Char.isDigit fieldName = customUnderscore fieldName + | otherwise = unwrapEither fieldName $ Inflector.toUnderscore fieldName + where + -- Custom underscore conversion that inserts underscores before digit sequences + -- and before uppercase letters + customUnderscore text = + text + |> Text.unpack + |> processChars + |> Text.pack + where + processChars :: String -> String + processChars [] = [] + processChars (c:cs) = c : go c cs + + go :: Char -> String -> String + go _ [] = [] + go prev (c:cs) + -- Insert underscore before a digit if previous char was a letter (transition from letter to digit) + | Char.isDigit c && Char.isLetter prev = '_' : c : go c cs + -- Insert underscore before uppercase letter if previous char was lowercase or digit + | Char.isUpper c && (Char.isLower prev || Char.isDigit prev) = '_' : Char.toLower c : go (Char.toLower c) cs + -- Keep uppercase letters as lowercase + | Char.isUpper c = Char.toLower c : go (Char.toLower c) cs + | otherwise = c : go c cs + -- | Returns a more friendly version for an identifier humanize :: Text -> Text humanize text = unwrapEither text $ Inflector.toHumanized True text diff --git a/ihp/Test/Test/NameSupportSpec.hs b/ihp/Test/Test/NameSupportSpec.hs index abbfa0da1..7466f7d3d 100644 --- a/ihp/Test/Test/NameSupportSpec.hs +++ b/ihp/Test/Test/NameSupportSpec.hs @@ -77,6 +77,12 @@ tests = do columnNameToFieldName "project_id" `shouldBe` "projectId" columnNameToFieldName "user_project_name" `shouldBe` "userProjectName" + it "should handle column names with numbers after underscores" do + columnNameToFieldName "foo_25bar" `shouldBe` "foo25bar" + columnNameToFieldName "test_123_column" `shouldBe` "test123Column" + columnNameToFieldName "user_2fa_enabled" `shouldBe` "user2faEnabled" + columnNameToFieldName "item_3d_model" `shouldBe` "item3dModel" + describe "fieldNameToColumnName" do it "should deal with empty input" do fieldNameToColumnName "" `shouldBe` "" @@ -86,6 +92,26 @@ tests = do fieldNameToColumnName "projectId" `shouldBe` "project_id" fieldNameToColumnName "userProjectName" `shouldBe` "user_project_name" + it "should handle field names with numbers to ensure round-trip" do + fieldNameToColumnName "foo25bar" `shouldBe` "foo_25bar" + fieldNameToColumnName "test123Column" `shouldBe` "test_123_column" + fieldNameToColumnName "user2faEnabled" `shouldBe` "user_2fa_enabled" + fieldNameToColumnName "item3dModel" `shouldBe` "item_3d_model" + + describe "columnNameToFieldName and fieldNameToColumnName round-trip" do + it "should round-trip correctly for column names with numbers after underscores" do + let roundTrip name = fieldNameToColumnName (columnNameToFieldName name) + roundTrip "foo_25bar" `shouldBe` "foo_25bar" + roundTrip "test_123_column" `shouldBe` "test_123_column" + roundTrip "user_2fa_enabled" `shouldBe` "user_2fa_enabled" + roundTrip "item_3d_model" `shouldBe` "item_3d_model" + + it "should preserve existing round-trip behavior for names without numbers after underscores" do + let roundTrip name = fieldNameToColumnName (columnNameToFieldName name) + roundTrip "project_id" `shouldBe` "project_id" + roundTrip "user_name" `shouldBe` "user_name" + roundTrip "created_at" `shouldBe` "created_at" + describe "lcfirst" do it "should deal with empty input" do lcfirst "" `shouldBe` ""