path: root/dev-haskell/th-expand-syns/files/th-expand-syns-0.3.0.4-ghc-7.10-1.patch

commit 2d8649d85bb1c728e8521b3a9aa6ebb2ff09586f
Author: Gabor Greif <ggreif@gmail.com>
Date:   Mon Jun 16 15:43:51 2014 +0200

    M-x whitespace-cleanup

diff --git a/Language/Haskell/TH/ExpandSyns.hs b/Language/Haskell/TH/ExpandSyns.hs
index 1110124..cc0dccf 100644
--- a/Language/Haskell/TH/ExpandSyns.hs
+++ b/Language/Haskell/TH/ExpandSyns.hs
@@ -7,9 +7,9 @@ module Language.Haskell.TH.ExpandSyns(-- * Expand synonyms
                                      ,substInType
                                      ,substInCon
                                      ,evades,evade) where
-    
+
 import Language.Haskell.TH hiding(cxt)
-import qualified Data.Set as Set    
+import qualified Data.Set as Set
 import Data.Generics
 import Control.Monad
 
@@ -20,26 +20,26 @@ import Control.Monad
 
 packagename :: String
 packagename = "th-expand-syns"
-    
-    
+
+
 -- Compatibility layer for TH >=2.4 vs. 2.3
 tyVarBndrGetName :: TyVarBndr -> Name
 mapPred :: (Type -> Type) -> Pred -> Pred
 bindPred :: (Type -> Q Type) -> Pred -> Q Pred
 tyVarBndrSetName :: Name -> TyVarBndr -> TyVarBndr
-                   
+
 #if MIN_VERSION_template_haskell(2,4,0)
 tyVarBndrGetName (PlainTV n) = n
 tyVarBndrGetName (KindedTV n _) = n
-                                
+
 mapPred f (ClassP n ts) = ClassP n (f <$> ts)
 mapPred f (EqualP t1 t2) = EqualP (f t1) (f t2)
-                            
+
 bindPred f (ClassP n ts) = ClassP n <$> mapM f ts
 bindPred f (EqualP t1 t2) = EqualP <$> f t1 <*> f t2
-                            
+
 tyVarBndrSetName n (PlainTV _) = PlainTV n
-tyVarBndrSetName n (KindedTV _ k) = KindedTV n k 
+tyVarBndrSetName n (KindedTV _ k) = KindedTV n k
 #else
 
 type TyVarBndr = Name
@@ -48,7 +48,7 @@ tyVarBndrGetName = id
 mapPred = id
 bindPred = id
 tyVarBndrSetName n _ = n
-                       
+
 #endif
 
 
@@ -70,29 +70,29 @@ nameIsSyn n = do
 #if MIN_VERSION_template_haskell(2,7,0)
     FamilyI (FamilyD flavour name _ _) _ -> maybeWarnTypeFamily flavour name >> return Nothing
 #endif
-    _ -> do 
+    _ -> do
             warn ("Don't know how to interpret the result of reify "++show n++" (= "++show i++").\n"++
                   "I will assume that "++show n++" is not a type synonym.")
             return Nothing
-        
+
 
 
 warn ::  String -> Q ()
-warn msg = 
+warn msg =
 #if MIN_VERSION_template_haskell(2,8,0)
     reportWarning
 #else
-    report False 
+    report False
 #endif
       (packagename ++": "++"WARNING: "++msg)
 
 
 #if MIN_VERSION_template_haskell(2,4,0)
 maybeWarnTypeFamily :: FamFlavour -> Name -> Q ()
-maybeWarnTypeFamily flavour name = 
+maybeWarnTypeFamily flavour name =
   case flavour of
     TypeFam ->
-      warn ("Type synonym families (and associated type synonyms) are currently not supported (they won't be expanded). Name of unsupported family: "++show name) 
+      warn ("Type synonym families (and associated type synonyms) are currently not supported (they won't be expanded). Name of unsupported family: "++show name)
 
     DataFam -> return ()
       -- Nothing to expand for data families, so no warning
@@ -129,8 +129,8 @@ expandSyns = \t ->
 
       -- If @go args t = (args', t')@,
       --
-      -- Precondition: 
-      --  All elements of `args' are expanded. 
+      -- Precondition:
+      --  All elements of `args' are expanded.
       -- Postcondition:
       --  All elements of `args'' and `t'' are expanded.
       --  `t' applied to `args' equals `t'' applied to `args'' (up to expansion, of course)
@@ -141,22 +141,22 @@ expandSyns = \t ->
       go acc x@ArrowT = passThrough acc x
       go acc x@(TupleT _) = passThrough acc x
       go acc x@(VarT _) = passThrough acc x
-                          
+
       go [] (ForallT ns cxt t) = do
         cxt' <- mapM (bindPred expandSyns) cxt
         t' <- expandSyns t
         return ([], ForallT ns cxt' t')
 
-      go acc x@(ForallT _ _ _) = 
+      go acc x@(ForallT _ _ _) =
           fail (packagename++": Unexpected application of the local quantification: "
                 ++show x
                 ++"\n    (to the arguments "++show acc++")")
-                                  
-      go acc (AppT t1 t2) = 
+
+      go acc (AppT t1 t2) =
           do
             r <- expandSyns t2
             go (r:acc) t1
-            
+
       go acc x@(ConT n) =
           do
             i <- nameIsSyn n
@@ -165,20 +165,20 @@ expandSyns = \t ->
               Just (vars,body) ->
                   if length acc < length vars
                   then fail (packagename++": expandSyns: Underapplied type synonym: "++show(n,acc))
-                  else 
+                  else
                       let
                           substs = zip vars acc
                           expanded = foldr subst body substs
                       in
                         go (drop (length vars) acc) expanded
-                        
+
 
 #if MIN_VERSION_template_haskell(2,4,0)
-      go acc (SigT t kind) = 
+      go acc (SigT t kind) =
           do
             (acc',t') <- go acc t
-            return 
-              (acc', 
+            return
+              (acc',
                 SigT t' kind
                 -- No expansion needed in kinds (todo: is this correct?)
               )
@@ -213,11 +213,11 @@ instance SubstTypeVariable Type where
                     | otherwise = s
       go ArrowT = ArrowT
       go ListT = ListT
-      go (ForallT vars cxt body) = 
+      go (ForallT vars cxt body) =
           commonForallCase (v,t) (vars,cxt,body)
-                        
+
       go s@(TupleT _) = s
-                        
+
 #if MIN_VERSION_template_haskell(2,4,0)
       go (SigT t1 kind) = SigT (go t1) kind
 #endif
@@ -237,23 +237,23 @@ instance SubstTypeVariable Type where
 #endif
 
 -- testCapture :: Type
--- testCapture = 
---     let 
+-- testCapture =
+--     let
 --         n = mkName
 --         v = VarT . mkName
 --     in
 --       substInType (n "x", v "y" `AppT` v "z")
---                   (ForallT 
---                    [n "y",n "z"] 
+--                   (ForallT
+--                    [n "y",n "z"]
 --                    [ConT (mkName "Show") `AppT` v "x" `AppT` v "z"]
 --                    (v "x" `AppT` v "y"))
 
-                        
+
 #if MIN_VERSION_template_haskell(2,4,0)
 instance SubstTypeVariable Pred where
     subst s = mapPred (subst s)
 #endif
-        
+
 
 -- | Make a name (based on the first arg) that's distinct from every name in the second arg
 --
@@ -268,7 +268,7 @@ instance SubstTypeVariable Pred where
 -- AST using 'mkName' to ensure a collision.
 --
 evade :: Data d => Name -> d -> Name
-evade n t = 
+evade n t =
     let
         vars :: Set.Set Name
         vars = everything Set.union (mkQ Set.empty Set.singleton) t
@@ -276,11 +276,11 @@ evade n t =
         go n1 = if n1 `Set.member` vars
                 then go (bump n1)
                 else n1
-                     
+
         bump = mkName . ('f':) . nameBase
     in
       go n
-         
+
 -- | Make a list of names (based on the first arg) such that every name in the result
 -- is distinct from every name in the second arg, and from the other results
 evades :: (Data t) => [Name] -> t -> [Name]
@@ -300,7 +300,7 @@ instance SubstTypeVariable Con where
       go (NormalC n ts) = NormalC n [(x, st y) | (x,y) <- ts]
       go (RecC n ts) = RecC n [(x, y, st z) | (x,y,z) <- ts]
       go (InfixC (y1,t1) op (y2,t2)) = InfixC (y1,st t1) op (y2,st t2)
-      go (ForallC vars cxt body) = 
+      go (ForallC vars cxt body) =
           commonForallCase (v,t) (vars,cxt,body)
 
 
@@ -316,18 +316,18 @@ instance HasForallConstruct Con where
 
 
 
-commonForallCase :: (SubstTypeVariable a, HasForallConstruct a) => 
+commonForallCase :: (SubstTypeVariable a, HasForallConstruct a) =>
 
-                    (Name,Type) 
+                    (Name,Type)
                  -> ([TyVarBndr],Cxt,a)
                  -> a
 commonForallCase vt@(v,t) (bndrs,cxt,body)
 
-            -- If a variable with the same name as the one to be replaced is bound by the forall, 
+            -- If a variable with the same name as the one to be replaced is bound by the forall,
             -- the variable to be replaced is shadowed in the body, so we leave the whole thing alone (no recursion)
-          | v `elem` (tyVarBndrGetName <$> bndrs) = mkForall bndrs cxt body 
+          | v `elem` (tyVarBndrGetName <$> bndrs) = mkForall bndrs cxt body
 
-          | otherwise = 
+          | otherwise =
               let
                   -- prevent capture
                   vars = tyVarBndrGetName <$> bndrs
@@ -336,11 +336,11 @@ commonForallCase vt@(v,t) (bndrs,cxt,body)
                   substs = zip vars (VarT <$> freshes)
                   doSubsts :: SubstTypeVariable b => b -> b
                   doSubsts x = foldr subst x substs
-                               
+
               in
-                mkForall 
+                mkForall
                   freshTyVarBndrs
-                  (fmap (subst vt . doSubsts) cxt ) 
+                  (fmap (subst vt . doSubsts) cxt )
                   (     (subst vt . doSubsts) body)