Skip to content

Instantly share code, notes, and snippets.

@dmjio
Created June 26, 2022 16:37
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dmjio/9af59531f17150d23b6ecc870be6bc2c to your computer and use it in GitHub Desktop.
Save dmjio/9af59531f17150d23b6ecc870be6bc2c to your computer and use it in GitHub Desktop.
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
import GHC.TypeLits
-- λ> :kind! F "Foo_" "Foo_Bar"
-- F "Foo_" "Foo_Bar" :: Symbol
-- = "bar"
type family F a b
where
F prefix value =
ToLowerCaseString (StripPrefix prefix value)
type family StripPrefix
(prefix :: Symbol)
(value :: Symbol)
where
StripPrefix prefix value =
Strip (UnconsSymbol prefix) (UnconsSymbol value)
type family Strip
(a :: Maybe (Char, Symbol))
(b :: Maybe (Char, Symbol)) :: Symbol
where
Strip Nothing (Just '(y, ys)) = ConsSymbol y ys
Strip (Just '(x, xs)) (Just '(x, ys)) = StripPrefix xs ys
Strip (Just '(x, xs)) (Just '(y, ys)) = ConsSymbol y ys
type family ToLower
(c :: Char) :: Char
where
ToLower c = NatToChar (CharToNat c + 32)
type family ToLowerCaseString
(c :: Symbol) :: Symbol
where
ToLowerCaseString xs =
Lower (UnconsSymbol xs)
type family Lower
(a :: Maybe (Char, Symbol)) :: Symbol
where
Lower (Just '(x, xs)) = ToLower x `ConsSymbol` xs
-- type family Drop
-- (n :: Nat)
-- (x :: Symbol)
-- where
-- Drop 0 x = x
-- Drop n x = Drop (n - 1) (Tail (UnconsSymbol x))
-- type family Tail
-- (x :: Maybe (Char, Symbol)) :: Symbol
-- where
-- Tail (Just '(_, xs)) = xs
@srid
Copy link

srid commented Jun 26, 2022

Here's StripPrefix implemented using the symbols package (which also provides ToLower and friends): kcsongor/symbols#3 ... it works on GHC versions <9.2.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment