1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00

🔥 the CustomConstructorName typeclass.

We can define ConstructorNameWithStrategy 'Custom instances instead.
This commit is contained in:
Rob Rix 2018-05-14 11:07:49 -04:00
parent 7532511c99
commit 347c18861e

View File

@ -36,15 +36,12 @@ class ConstructorName syntax where
instance (ConstructorNameStrategy syntax ~ strategy, ConstructorNameWithStrategy strategy syntax) => ConstructorName syntax where
constructorName = constructorNameWithStrategy (Proxy :: Proxy strategy)
class CustomConstructorName syntax where
customConstructorName :: syntax a -> String
instance Apply ConstructorName fs => ConstructorNameWithStrategy 'Custom (Sum fs) where
constructorNameWithStrategy _ = apply @ConstructorName constructorName
instance Apply ConstructorName fs => CustomConstructorName (Sum fs) where
customConstructorName = apply @ConstructorName constructorName
instance CustomConstructorName [] where
customConstructorName [] = "[]"
customConstructorName _ = ""
instance ConstructorNameWithStrategy 'Custom [] where
constructorNameWithStrategy _ [] = "[]"
constructorNameWithStrategy _ _ = ""
data Strategy = Default | Custom
@ -59,9 +56,6 @@ class ConstructorNameWithStrategy (strategy :: Strategy) syntax where
instance (Generic1 syntax, GConstructorName (Rep1 syntax)) => ConstructorNameWithStrategy 'Default syntax where
constructorNameWithStrategy _ = gconstructorName . from1
instance CustomConstructorName syntax => ConstructorNameWithStrategy 'Custom syntax where
constructorNameWithStrategy _ = customConstructorName
class GConstructorName f where
gconstructorName :: f a -> String