Search code examples
haskelltype-level-computation

Simplest way to do type-level `Symbol` formatting in Haskell

Given two Symbols a and b, what is the simplest way to create another symbol that is equivalent to b but its prefix a stripped and the rest made lower case and slugified?

For example, how to implement this type family such that RoutePath "Foo" "Foo_BarQux" == "bar-qux" (the kebab case is optional)?

type family RoutePath datatype constr where 
  RoutePath datatype constr = undefined -- TODO

GHC.TypeLits does provide UnconsSymbol that I can use to implement this sort of thing from scratch, but it feels too low-level. I'm wondering if there is an existing solution (a library perhaps) that I can adopt to keep code in my library smaller and simpler.

For real-word context, see this PR in particular the Constructor2RoutePath type family.

Solution

  • symbols package

    I came across the symbols package. It provides a ToList (sym :: Symbol) :: [Symbol] type family which enables me to process the Symbol as a list, however, I learned that it makes the compilation extremely slow. Here's the code for that.

    GHC 9.2's UnconsSymbol

    That left me with no choice but to upgrade to GHC 9.2. On the plus side, the compilation is as swift as it was before. Here's the implementation in full:

    import GHC.TypeLits (ConsSymbol, Symbol, UnconsSymbol)

-- | Strip `prefix` from `symbol`. Return `symbol` as-is if the prefix doesn't match.
type family StripPrefix (prefix :: Symbol) (symbol :: Symbol) :: Symbol where
  StripPrefix prefix symbol =
    FromMaybe
      symbol
      (StripPrefix' (UnconsSymbol prefix) (UnconsSymbol symbol))

-- | Strip `prefix` from `symbol`. Return Nothing if the prefix doesn't match.
type family StripPrefix' (prefix :: Maybe (Char, Symbol)) (symbol :: Maybe (Char, Symbol)) :: Maybe Symbol where
  StripPrefix' 'Nothing 'Nothing = 'Just ""
  StripPrefix' 'Nothing ( 'Just '(x, xs)) = 'Just (ConsSymbol x xs)
  StripPrefix' _p 'Nothing = 'Nothing
  StripPrefix' ( 'Just '(p, ps)) ( 'Just '(p, ss)) = StripPrefix' (UnconsSymbol ps) (UnconsSymbol ss)
  StripPrefix' ( 'Just '(p, ps)) ( 'Just '(_, ss)) = 'Nothing

type family ToLower (sym :: Symbol) :: Symbol where
  ToLower sym = ToLower' (UnconsSymbol sym)

type family ToLower' (pair :: Maybe (Char, Symbol)) :: Symbol where
  ToLower' 'Nothing = ""
  ToLower' ( 'Just '(c, cs)) = ConsSymbol (ToLowerC c) (ToLower' (UnconsSymbol cs))

type family ToLowerC (c :: Char) :: Char where
  ToLowerC 'A' = 'a'
  ToLowerC 'B' = 'b'
  ToLowerC 'C' = 'c'
  ToLowerC 'D' = 'd'
  ToLowerC 'E' = 'e'
  ToLowerC 'F' = 'f'
  ToLowerC 'G' = 'g'
  ToLowerC 'H' = 'h'
  ToLowerC 'I' = 'i'
  ToLowerC 'J' = 'j'
  ToLowerC 'K' = 'k'
  ToLowerC 'L' = 'l'
  ToLowerC 'M' = 'm'
  ToLowerC 'N' = 'n'
  ToLowerC 'O' = 'o'
  ToLowerC 'P' = 'p'
  ToLowerC 'Q' = 'q'
  ToLowerC 'R' = 'r'
  ToLowerC 'S' = 's'
  ToLowerC 'T' = 't'
  ToLowerC 'U' = 'u'
  ToLowerC 'V' = 'v'
  ToLowerC 'W' = 'w'
  ToLowerC 'X' = 'x'
  ToLowerC 'Y' = 'y'
  ToLowerC 'Z' = 'z'
  ToLowerC a = a

type family FromMaybe (def :: a) (maybe :: Maybe a) :: a where
  FromMaybe def 'Nothing = def
  FromMaybe def ( 'Just a) = a

    Link to the rewrite.

    It is not as complex as I had envisioned it when posting this question. It doesn't do the Kebab case conversion though, but I imagine that's not too complicated to achieve.