Casing edge cases

[parsonsmatt]

I have a Haskell field like addressLine1 and I use snakeCase to convert that to snake case for the aeson representation. The parser expects a field named address_line1, but the API returns address_line_1.

It would obviously be bad for a field like foo1234 to show up as foo_1_2_3_4, but I would expect it to render as foo_1234. I don't think that's unambiguously correct, though - expecting it to output foo1234 also seems reasonable to me.

Another case is fooID or someHTTPConfig - these get rendered as foo_i_d and some_h_t_t_p_config. This is probably not desired - I'd expect foo_id and some_http_config as the output of those functions.

I wrote some rather tricky code that handles these cases correctly for work. Specifically, we wanted to render an enum-like sum type with spaces in between the words, but it'd be easy to port this to make it do snake_caseing:

-- | Used for converting an enum with a derived 'Show' instance into a title
-- case. Drops the type name prefix if present.
--
-- This function will produce weird results on interesting sum types - it's best
-- to only use it on boring enum-like types.
constructorToTitleWords :: forall a. (Typeable a, Show a) => a -> String
constructorToTitleWords constr =
  insertSpaces
    $ fromMaybe constrStr
    $ List.stripPrefix (show (typeOf constr))
    $ constrStr
  where
    constrStr = show constr
    insertSpaces [] = []
    insertSpaces chars =
      let
        withNext =
          withLastAndNext chars

        insertSpace =
          concatMap
            $ \(mp, c, mn) ->
              if isUpperM mp && C.isUpper c && isUpperM mn
              then [c]
              else if isUpperM mp && C.isLower c && isLowerM mn
              then [c]
              else if isUpperM mp && C.isUpper c && isLowerM mn
              then [' ', c]
              else if isJust mp && C.isUpper c && isLowerM mn
              then [' ', c]
              else if isLowerM mp && C.isUpper c
              then [' ', c]
              else if not (isDigitM mp) && C.isDigit c
              then [' ', c]
              else [c]

        isLowerM = maybe False C.isLower
        isUpperM = maybe False C.isUpper
        isDigitM = maybe False C.isDigit
       in
        insertSpace withNext

withLastAndNext :: [a] -> [(Maybe a, a, Maybe a)]
withLastAndNext xs =
  mkSuccession (Nothing : fmap Just xs) xs (Just <$> drop 1 xs)
  where
    mkSuccession (cp : cps) (cc : ccs) (cn : cns) =
      (cp, cc, cn) : mkSuccession cps ccs cns
    mkSuccession (cp : cps) (cc : ccs) [] =
      (cp, cc, Nothing) : mkSuccession cps ccs []
    mkSuccession _ [] _ =
      []
    mkSuccession _ _ _ =
      error
      $ "mkSuccession internal invariant failed: lists did not have the "
      <> "right lengths."

-- tests:
data ConstructorToTitleWordsTest
    = NoTypePrefix
    | ConstructorToTitleWordsTestWithTypePrefix
    | WithAcronymHTTPHooray
    | IAmSorryForThisEdgeCase
    | TwoAcronymEdgeCaseHTTPFTP
    | OhManNumbers1234
    deriving (Show, Read, Eq)

spec :: Spec
spec = do
  describe "constructorToTitleWords" $ do
    it "works" $ do
      constructorToTitleWords NoTypePrefix
          `shouldBe`
              "No Type Prefix"
    it "strips type prefix" $ do
      constructorToTitleWords ConstructorToTitleWordsTestWithTypePrefix
        `shouldBe`
          "With Type Prefix"
    it "doesn't bork acronyms" $ do
      constructorToTitleWords WithAcronymHTTPHooray
        `shouldBe`
          "With Acronym HTTP Hooray"
    it "does not handle single letter words" $ do
      constructorToTitleWords IAmSorryForThisEdgeCase
        `shouldBe`
          "I Am Sorry For This Edge Case"
    it "does not handle two adjacent acronyms" $ do
      constructorToTitleWords TwoAcronymEdgeCaseHTTPFTP
        `shouldBe`
          "Two Acronym Edge Case HTTPFTP"
    it "works with numbers" $ do
      constructorToTitleWords OhManNumbers1234
        `shouldBe`
          "Oh Man Numbers 1234"

[danwdart]

Seems also as if acronyms might go from e.g. postURL to post_u_r_l instead of post_url.