Given two Symbol
s 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.
CodePudding user response:
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.