X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FImplant%2FRewrite.hs;h=9ed1d8def3c5d2206cf0392a41bb6eeea40feb66;hb=2bcf36a739341aaaf56d812286d57233fff81ad5;hp=69b8aee28ecfb276d139d4c434cc05e01cd01e2e;hpb=19763f7de78daf2d4c794f4010039f70c7f73994;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Implant/Rewrite.hs b/Network/HTTP/Lucu/Implant/Rewrite.hs
index 69b8aee..9ed1d8d 100644
--- a/Network/HTTP/Lucu/Implant/Rewrite.hs
+++ b/Network/HTTP/Lucu/Implant/Rewrite.hs
@@ -33,7 +33,7 @@ import Data.Generics.Aliases hiding (GT)
 import Data.Generics.Schemes
 import Data.Monoid
 import Data.Monoid.Unicode
-import qualified Data.Set as S
+import qualified Data.Set as S (Set)
 import Language.Haskell.TH.Syntax
 import Prelude hiding (filter, foldr, lookup)
 import Prelude.Unicode
@@ -81,6 +81,7 @@ data RewriteRule
       , rrImps ∷ !Imports
       }
 
+-- |@'insert' imp@ merges @imp@ with an existing one if any.
 instance Unfoldable Imports ImportOp where
     insert qi@(QualifiedImp   {}) (Imports s) = Imports $ insert qi s
     insert ui@(UnqualifiedImp {}) (Imports s)
@@ -101,17 +102,22 @@ instance Unfoldable Imports ImportOp where
                   (_      , Nothing ) → ui'
                   (Just ns, Just ns') → ui { impNames = Just (ns ⊕ ns') }
 
+    empty     = Imports empty
+    singleton = Imports ∘ singleton
+
+-- FIXME: auto-derive
 instance Foldable Imports ImportOp where
     foldr f b (Imports s) = foldr f b s
 
+-- FIXME: auto-derive
 instance Collection Imports ImportOp where
     filter f (Imports s) = Imports $ filter f s
 
 instance Monoid Imports where
-    mempty = empty
-    mappend (Imports α) (Imports β)
-        = Imports $ insertManySorted β α
+    mempty  = empty
+    mappend = insertMany
 
+-- FIXME: auto-derive
 instance Map Imports ImportOp () where
     lookup k (Imports s) = lookup k s
     mapWithKey f (Imports m)
@@ -127,9 +133,11 @@ instance Map Imports ImportOp () where
     isProperSubmapBy f (Imports α) (Imports β)
         = isProperSubmapBy f α β
 
+-- FIXME: auto-derive
 instance Set Imports ImportOp where
     haddock_candy = haddock_candy
 
+-- FIXME: auto-derive
 instance SortingCollection Imports ImportOp where
     minView (Imports s) = second Imports <$> minView s
 
@@ -163,8 +171,7 @@ qualifyAll m a
 unqualify ∷ Name → String → RewriteRule
 unqualify (Name o _) m
     = let pat = NamePat Nothing (Just o)
-          iop = UnqualifiedImp (mkModName m)
-                $ Just
+          iop = UnqualifiedImp (mkModName m) ∘ Just
                 $ singleton (VarName, o)
       in
         RewriteRule pat Unqualify (singleton iop)
@@ -175,8 +182,7 @@ unqualify (Name o _) m
 unqualifyIn ∷ Name → Name → String → RewriteRule
 unqualifyIn (Name name _) (Name tycl _) m
     = let pat = NamePat Nothing (Just name)
-          iop = UnqualifiedImp (mkModName m)
-                $ Just
+          iop = UnqualifiedImp (mkModName m) ∘ Just
                 $ singleton (TcClsName, tycl)
       in
         RewriteRule pat Unqualify (singleton iop)