1 files changed, 46 insertions, 9 deletions
diff --git a/www/hs-activehs/files/patch-Specialize.hs b/www/hs-activehs/files/patch-Specialize.hs
index 73c64c19329d..0c4371a06918 100644
--- a/www/hs-activehs/files/patch-Specialize.hs
+++ b/www/hs-activehs/files/patch-Specialize.hs
@@ -1,11 +1,48 @@
---- ./Specialize.hs.orig	2013-02-12 19:23:45.000000000 +0000
-+++ ./Specialize.hs	2013-08-28 17:32:07.000000000 +0100
-@@ -15,7 +15,7 @@
+--- Specialize.hs.orig	2017-07-30 10:48:49 UTC
++++ Specialize.hs
+@@ -23,32 +23,32 @@ specialize a
  
- specialize :: String -> Either String (String, String)
- specialize a
--    = case parseTypeWithMode (defaultParseMode {extensions = [FlexibleContexts]}) a of
-+    = case parseTypeWithMode (defaultParseMode {extensions = [EnableExtension FlexibleContexts]}) a of
-         ParseFailed loc s -> Left $ show s
-         ParseOk t -> let
+             in Right (prettyPrint t', prettyPrint t'')
  
+-split :: Type -> ([(String, [String])], Type)
+-split (TyForall Nothing l t) 
++split :: Type a -> ([(String, [String])], Type a)
++split (TyForall _ Nothing (Just (CxTuple _ l)) t)
+     = ( map (\x -> (fst (head x), map snd x)) $ groupBy ((==) `on` fst) $ sort
+-          [(v,s) | ClassA (UnQual (Ident s)) [TyVar (Ident v)]<-l]
++          [(v,s) | ClassA _ (UnQual _ (Ident _ s)) [TyVar _ (Ident _ v)]<-l]
+       , t
+       )
+ split t 
+     = ([], t)
+ 
+-convert :: ([(String, [String])], Type) -> (Type, Type)
++convert :: ([(String, [String])], Type a) -> (Type a, Type a)
+ convert (m, t) = (app True mm t, app False mm t)  where mm = map resolve m
+ 
+-app :: Bool -> [(String, [[Char]])] -> Type -> Type
++app :: Bool -> [(String, [[Char]])] -> Type a -> Type a
+ app b m t = f t where
+-    f (TyFun a b) = TyFun (f a) (f b)
+-    f (TyTuple bo l) = TyTuple bo $ map f l
+-    f (TyList t) = TyList (f t)
+-    f (TyParen t) = TyParen (f t)
+-    f (TyApp x t) = TyApp (f x) (f t)
+-    f (TyVar (Ident s)) = mkV $ head $ [y | (v,x)<-m, v==s, y<-ff  x] ++ ff allT
++    f (TyFun t a b) = TyFun t (f a) (f b)
++    f (TyTuple t bo l) = TyTuple t bo $ map f l
++    f (TyList x t) = TyList x (f t)
++    f (TyParen x t) = TyParen x (f t)
++    f (TyApp v x t) = TyApp v (f x) (f t)
++    f (TyVar v (Ident _ s)) = mkV v $ head $ [y | (v,x)<-m, v==s, y<-ff  x] ++ ff allT
+     f t = t
+ 
+     ff = if b then id else reverse
+ 
+-mkV :: String -> Type
+-mkV v = TyVar $ Ident v
++mkV :: a -> String -> Type a
++mkV x v = TyVar x $ Ident x v
+ 
+ resolve :: (String, [String]) -> (String, [String])
+ resolve (v, l) = (v, foldl1 intersect $ map res l)