X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Data%2FCollections%2FNewtype%2FTH.hs;fp=Data%2FCollections%2FNewtype%2FTH.hs;h=c60ea2b9b823311c05a1b9fa6faf4e5b365055a5;hp=d392758a4be3c3eaaaaa690037b2fdbef8b6aa97;hb=f7fdfa7b306619a37f31504109b23c362066ec8b;hpb=b2da45926a7900603a5426e0c6d65e3ca630a1a2

diff --git a/Data/Collections/Newtype/TH.hs b/Data/Collections/Newtype/TH.hs
index d392758..c60ea2b 100644
--- a/Data/Collections/Newtype/TH.hs
+++ b/Data/Collections/Newtype/TH.hs
@@ -59,6 +59,8 @@ inspectInstance (AppT (AppT (ConT classTy) wrapperTy) _)
         = return (wrapperTy, deriveFoldable)
     | classTy ≡ ''Collection
         = return (wrapperTy, deriveCollection)
+    | classTy ≡ ''Set
+        = return (wrapperTy, deriveSet)
     | classTy ≡ ''SortingCollection
         = return (wrapperTy, deriveSortingCollection)
 inspectInstance (AppT (AppT (AppT (ConT classTy) wrapperTy) _) _)
@@ -254,6 +256,18 @@ deriveMap c ty wrap unwrap
           | otherwise
               = fail $ "deriveMap: unknown method: " ⧺ pprint name
 
+deriveSet ∷ Q Cxt → Q Type → Q Exp → Q Exp → Q Dec
+deriveSet c ty _ _
+    = do names ← methodNames ''Set
+         instanceD c ty $ concatMap (pointfreeMethod exp) names
+    where
+      exp ∷ Name → Q Exp
+      exp name
+          | name ≡ 'haddock_candy
+              = [| haddock_candy |]
+          | otherwise
+              = fail $ "deriveSet: unknown method: " ⧺ pprint name
+
 deriveSortingCollection ∷ Q Cxt → Q Type → Q Exp → Q Exp → Q Dec
 deriveSortingCollection c ty wrap unwrap
     = do names ← methodNames ''SortingCollection