aboutsummaryrefslogtreecommitdiff
path: root/www/hs-activehs
diff options
context:
space:
mode:
Diffstat (limited to 'www/hs-activehs')
-rw-r--r--www/hs-activehs/Makefile15
-rw-r--r--www/hs-activehs/distinfo5
-rw-r--r--www/hs-activehs/files/patch-Converter.hs87
-rw-r--r--www/hs-activehs/files/patch-Main.hs12
-rw-r--r--www/hs-activehs/files/patch-Parse.hs94
-rw-r--r--www/hs-activehs/files/patch-Qualify.hs76
-rw-r--r--www/hs-activehs/files/patch-QuickCheck.hs50
-rw-r--r--www/hs-activehs/files/patch-Simple.hs38
-rw-r--r--www/hs-activehs/files/patch-Specialize.hs55
-rw-r--r--www/hs-activehs/files/patch-activehs.cabal77
10 files changed, 300 insertions, 209 deletions
diff --git a/www/hs-activehs/Makefile b/www/hs-activehs/Makefile
index 010daff183c9..80403ea395d6 100644
--- a/www/hs-activehs/Makefile
+++ b/www/hs-activehs/Makefile
@@ -1,8 +1,7 @@
# $FreeBSD$
PORTNAME= activehs
-PORTVERSION= 0.3.1
-PORTREVISION= 12
+PORTVERSION= 0.3.2
CATEGORIES= www haskell
MAINTAINER= haskell@FreeBSD.org
@@ -10,13 +9,11 @@ COMMENT= Haskell code presentation tool
LICENSE= BSD3CLAUSE
-USE_CABAL= activehs-base>=0.2 blaze-html>=0.5 blaze-markup>=0.5.1.0 \
- cmdargs>=0.7 data-pprint>=0.2 dia-base>=0.1 \
- dia-functions>=0.2.1.1 exceptions>=0.6 haskell-src-exts>=1.12 \
- highlighting-kate>=0.5 hint>=0.3.3.2 hoogle>=4.2.11 mtl>=2.0 \
- pandoc>=1.12 pureMD5>=2.1 QuickCheck>=2.4 simple-reflect>=0.2 \
- snap-core>=0.6 snap-server>=0.6 split>=0.1 syb>=0.2 \
- text>=0.11 utf8-string>=0.3
+USE_CABAL= activehs-base blaze-html blaze-markup cmdargs data-pprint \
+ dia-base dia-functions exceptions haskell-src-exts \
+ highlighting-kate hint hoogle mtl pandoc pureMD5 \
+ QuickCheck simple-reflect snap-core snap-server split syb \
+ text utf8-string
STANDALONE= yes
EXECUTABLE= activehs
diff --git a/www/hs-activehs/distinfo b/www/hs-activehs/distinfo
index 6846af2f7017..c2289b0c3e26 100644
--- a/www/hs-activehs/distinfo
+++ b/www/hs-activehs/distinfo
@@ -1,2 +1,3 @@
-SHA256 (cabal/activehs-0.3.1.tar.gz) = 0c0ab3ef3338d713d0bde0ce288199ce28c6401e27545691f04e08450403ea0f
-SIZE (cabal/activehs-0.3.1.tar.gz) = 33193
+TIMESTAMP = 1501411977
+SHA256 (cabal/activehs-0.3.2.tar.gz) = f70dfee1dbed1edce6d6ecec56a4c16ec4b9462e5b52130058c3bdd85659ab58
+SIZE (cabal/activehs-0.3.2.tar.gz) = 33457
diff --git a/www/hs-activehs/files/patch-Converter.hs b/www/hs-activehs/files/patch-Converter.hs
index 3e23716431c6..ea445675558b 100644
--- a/www/hs-activehs/files/patch-Converter.hs
+++ b/www/hs-activehs/files/patch-Converter.hs
@@ -1,38 +1,77 @@
---- Converter.hs.orig 2013-02-12 19:23:45 UTC
+--- Converter.hs.orig 2017-07-30 10:48:49 UTC
+++ Converter.hs
-@@ -28,7 +28,7 @@ import System.Directory (getTemporaryDir
+@@ -53,7 +53,7 @@ convert ghci args@(Args {magicname, sourcedir, gendir,
+ object = sourcedir </> what <.> "o"
- import Control.Monad
- import Data.List
--import Data.Char
-+import Data.Char hiding (Format)
- ----------------------------------
+-extract :: ParseMode -> Bool -> TaskChan -> Args -> Language -> Doc -> IO ()
++extract :: ParseMode -> Bool -> TaskChan -> Args -> Language -> Doc loc -> IO ()
+ extract mode verbose ghci (Args {lang, templatedir, sourcedir, exercisedir, gendir, magicname}) what (Doc meta modu ss) = do
-@@ -206,7 +206,7 @@ preprocessForSlides x = case span (not .
- ------------------------------------
+ writeEx (what <.> ext) [showEnv mode $ importsHiding []]
+@@ -63,10 +63,9 @@ extract mode verbose ghci (Args {lang, templatedir, so
- rawHtml :: String -> Block
--rawHtml x = RawBlock "html" x
-+rawHtml x = RawBlock (Format "html") x
+ writeFile' (gendir </> what <.> "xml") $ flip writeHtmlString (Pandoc meta $ concat ss')
+ $ def
+- { writerStandalone = True
+- , writerTableOfContents = True
++ { writerTableOfContents = True
+ , writerSectionDivs = True
+- , writerTemplate = ht
++ , writerTemplate = Just ht
+ }
+
+ where
+@@ -95,10 +94,10 @@ extract mode verbose ghci (Args {lang, templatedir, so
+ system s
+
+ importsHiding funnames = case modu of
+- HaskellModule (HSyn.Module loc (HSyn.ModuleName modname) directives _ _ imps _) ->
++ HaskellModule (HSyn.Module loc (Just (HSyn.ModuleHead _ (HSyn.ModuleName _ modname) _ _)) directives imps _) ->
+ HPty.prettyPrint $
+- HSyn.Module loc (HSyn.ModuleName "") directives Nothing Nothing
+- ([mkImport modname funnames, mkImport_ ('X':magicname) modname] ++ imps) []
++ HSyn.Module loc Nothing directives
++ ([mkImport loc modname funnames, mkImport_ loc ('X':magicname) modname] ++ imps) []
+ -- _ -> error "error in Converter.extract"
- showBlockSimple :: Language -> String -> String -> Int -> String -> [Block]
+ mkCodeBlock l =
+@@ -237,27 +236,26 @@ showEnv HaskellMode prelude
+ ++ prelude
+ ++ "\n{-# LINE 1 \"input\" #-}\n"
-@@ -244,13 +244,14 @@ mkImport m d
+-mkImport :: String -> [Name] -> HSyn.ImportDecl
+-mkImport m d
++mkImport :: loc -> String -> [Name] -> HSyn.ImportDecl loc
++mkImport loc m d
+ = HSyn.ImportDecl
+- { HSyn.importLoc = undefined
+- , HSyn.importModule = HSyn.ModuleName m
++ { HSyn.importModule = HSyn.ModuleName loc m
+ , HSyn.importQualified = False
, HSyn.importSrc = False
, HSyn.importPkg = Nothing
, HSyn.importAs = Nothing
- , HSyn.importSpecs = Just (True, map (HSyn.IVar . mkName) d)
-+ , HSyn.importSpecs = Just (True, map (HSyn.IVar HSyn.NoNamespace . mkName) d)
-+ , HSyn.importSafe = False
++ , HSyn.importSpecs = Just (HSyn.ImportSpecList loc True (map (HSyn.IVar loc . mkName loc) d))
+ , HSyn.importSafe = False
}
- mkName :: String -> HSyn.Name
- mkName n@(c:_)
-- | isSymbol c = HSyn.Symbol n
--mkName n = HSyn.Ident n
-+ | isLetter c = HSyn.Ident n
-+mkName n = HSyn.Symbol n
+-mkName :: String -> HSyn.Name
+-mkName n@(c:_)
+- | isLetter c = HSyn.Ident n
+-mkName n = HSyn.Symbol n
++mkName :: loc -> String -> HSyn.Name loc
++mkName loc n@(c:_)
++ | isLetter c = HSyn.Ident loc n
++mkName loc n = HSyn.Symbol loc n
+
+-mkImport_ :: String -> String -> HSyn.ImportDecl
+-mkImport_ magic m
+- = (mkImport m []) { HSyn.importQualified = True, HSyn.importAs = Just $ HSyn.ModuleName magic }
++mkImport_ :: loc -> String -> String -> HSyn.ImportDecl loc
++mkImport_ loc magic m
++ = (mkImport loc m []) { HSyn.importQualified = True, HSyn.importAs = Just $ HSyn.ModuleName loc magic }
+
+ ------------------
- mkImport_ :: String -> String -> HSyn.ImportDecl
- mkImport_ magic m
diff --git a/www/hs-activehs/files/patch-Main.hs b/www/hs-activehs/files/patch-Main.hs
deleted file mode 100644
index dd63e11e4705..000000000000
--- a/www/hs-activehs/files/patch-Main.hs
+++ /dev/null
@@ -1,12 +0,0 @@
---- Main.hs.orig 2013-02-12 19:23:46 UTC
-+++ Main.hs
-@@ -28,8 +28,7 @@ import System.Directory (doesFileExist)
- import Control.Concurrent (threadDelay)
- import Control.Monad (when)
- import Control.Applicative ((<|>))
--import System.Locale (defaultTimeLocale)
--import Data.Time (getCurrentTime, formatTime, diffUTCTime)
-+import Data.Time (getCurrentTime, formatTime, diffUTCTime, defaultTimeLocale)
- import Data.Maybe (listToMaybe)
- --import Prelude hiding (catch)
-
diff --git a/www/hs-activehs/files/patch-Parse.hs b/www/hs-activehs/files/patch-Parse.hs
index 1ebb809b29bb..3fe4d59c4070 100644
--- a/www/hs-activehs/files/patch-Parse.hs
+++ b/www/hs-activehs/files/patch-Parse.hs
@@ -1,27 +1,85 @@
---- Parse.hs.orig 2013-02-12 19:23:45 UTC
+--- Parse.hs.orig 2017-07-30 10:48:49 UTC
+++ Parse.hs
-@@ -72,12 +72,13 @@ mainParse :: ParseMode -> FilePath -> IO
+@@ -17,6 +17,7 @@ import Text.Pandoc
+
+ import qualified Language.Haskell.Exts.Parser as HPar
+ import qualified Language.Haskell.Exts.Syntax as HSyn
++import qualified Language.Haskell.Exts.SrcLoc as HLoc
+
+ import Data.List.Split (splitOn)
+ import Data.List (tails, partition, groupBy)
+@@ -30,15 +31,15 @@ import qualified Data.Set as Set
+ data ParseMode = HaskellMode -- | AgdaMode
+ deriving (Show, Enum, Eq)
+
+-data Module
+- = HaskellModule HSyn.Module
++data Module loc
++ = HaskellModule (HSyn.Module loc)
+ -- | AgdaModule ASyn.Module
+ deriving (Show)
+
+-data Doc
++data Doc loc
+ = Doc
+ Meta{-title, author, date-}
+- Module{-module directives, module name, imports-}
++ (Module{-module directives, module name, imports-} loc)
+ [BBlock]
+ deriving (Show)
+
+@@ -68,7 +69,7 @@ testCommandList = "EeFfH"
+
+ -----------------------------------
+
+-mainParse :: ParseMode -> FilePath -> IO Doc
++mainParse :: ParseMode -> FilePath -> IO (Doc HLoc.SrcSpanInfo)
mainParse mode s = do
c <- readFile s
case readMarkdown pState . unlines . concatMap preprocess . lines $ c of
-- Pandoc meta (CodeBlock ("",["sourceCode","literate","haskell"],[]) h: blocks) -> do
-+ Right (Pandoc meta (CodeBlock ("",["sourceCode","literate","haskell"],[]) h: blocks)) -> do
- header <- parseModule mode $ h
- fmap (Doc meta header) $ collectTests mode $ map ({-highlight . -}interpreter . Text) blocks
-- Pandoc meta blocks -> do
-+ Right (Pandoc meta blocks) -> do
- header <- parseModule mode $ "module Unknown where"
+@@ -80,7 +81,7 @@ mainParse mode s = do
fmap (Doc meta header) $ collectTests mode $ map ({-highlight . -}interpreter . Text) blocks
-+ Left err -> fail $ "readMarkdown: " ++ show err
+ Left err -> fail $ "readMarkdown: " ++ show err
where
- parseModule :: ParseMode -> String -> IO Module
+- parseModule :: ParseMode -> String -> IO Module
++ parseModule :: ParseMode -> String -> IO (Module HLoc.SrcSpanInfo)
parseModule HaskellMode m = case HPar.parseModuleWithMode HPar.defaultParseMode m of
-@@ -137,7 +138,7 @@ processHaskellLines isExercise l_ = retu
+ (HPar.ParseOk m) -> return $ HaskellModule m
+ parseError -> fail $ "parseHeader: " ++ show parseError
+@@ -137,17 +138,17 @@ processHaskellLines isExercise l_ = return (concatMap
+ names = concatMap (getFName . snd) x
getFName (HPar.ParseOk x) = case x of
- HSyn.TypeSig _ a _ -> map printName a
-- HSyn.PatBind _ (HSyn.PVar a) _ _ _ -> [printName a]
-+ HSyn.PatBind _ (HSyn.PVar a) _ _ -> [printName a]
- HSyn.FunBind (HSyn.Match _ a _ _ _ _ :_) -> [printName a]
- HSyn.TypeDecl _ a _ _ -> [printName a]
- HSyn.DataDecl _ _ _ a _ x _ -> printName a: [printName n | HSyn.QualConDecl _ _ _ y<-x, n <- getN y]
+- HSyn.TypeSig _ a _ -> map printName a
+- HSyn.PatBind _ (HSyn.PVar a) _ _ -> [printName a]
+- HSyn.FunBind (HSyn.Match _ a _ _ _ _ :_) -> [printName a]
+- HSyn.TypeDecl _ a _ _ -> [printName a]
+- HSyn.DataDecl _ _ _ a _ x _ -> printName a: [printName n | HSyn.QualConDecl _ _ _ y<-x, n <- getN y]
+- _ -> []
++ HSyn.TypeSig _ a _ -> map printName a
++ HSyn.PatBind _ (HSyn.PVar _ a) _ _ -> [printName a]
++ HSyn.FunBind _ ((HSyn.Match _ a _ _ _):_) -> [printName a]
++ HSyn.TypeDecl _ (HSyn.DHead _ a) _ -> [printName a]
++ HSyn.DataDecl _ _ _ (HSyn.DHead _ a) x _ -> printName a: [printName n | HSyn.QualConDecl _ _ _ y<-x, n <- getN y]
++ _ -> []
+ getFName _ = []
+
+- getN (HSyn.ConDecl n _) = [n]
+- getN (HSyn.InfixConDecl _ n _) = [n]
+- getN (HSyn.RecDecl n l) = n: concatMap fst l
++ getN (HSyn.ConDecl _ n _) = [n]
++ getN (HSyn.InfixConDecl _ _ n _) = [n]
++ getN (HSyn.RecDecl _ n l) = n : concatMap (\(HSyn.FieldDecl _ xs _) -> xs) l
+
+ isVisible (HPar.ParseOk (HSyn.TypeSig _ _ _)) = True
+ isVisible (HPar.ParseOk (HSyn.InfixDecl _ _ _ _)) = True
+@@ -181,6 +182,6 @@ parseQuickCheck :: String -> ([String], String)
+ parseQuickCheck s = case splitOn ";;" s of
+ l -> (init l, last l)
+
+-printName :: HSyn.Name -> Name
+-printName (HSyn.Ident x) = x
+-printName (HSyn.Symbol x) = x
++printName :: HSyn.Name loc -> Name
++printName (HSyn.Ident _ x) = x
++printName (HSyn.Symbol _ x) = x
diff --git a/www/hs-activehs/files/patch-Qualify.hs b/www/hs-activehs/files/patch-Qualify.hs
new file mode 100644
index 000000000000..b9a90bf0bb18
--- /dev/null
+++ b/www/hs-activehs/files/patch-Qualify.hs
@@ -0,0 +1,76 @@
+--- Qualify.hs.orig 2017-07-30 10:48:49 UTC
++++ Qualify.hs
+@@ -21,44 +21,47 @@ qualify
+ -> String -- ^ Haskell expression
+ -> Either String String -- ^ either the modified expression or an error
+ qualify q ns x = case parseExpWithMode defaultParseMode x of
+- ParseOk y -> Right $ prettyPrint $ runReader (trExp y) ns
++ ParseOk y -> Right $ prettyPrint $ runReader (trExp proxy y) ns
+ e -> Left $ show e
+- where
+- trQName :: QName -> R QName
+- trQName y@(UnQual x) = do
+- b <- asks (printName x `elem`)
+- return $ if b then (Qual (ModuleName q) x) else y
+- trQName y = return y
++ where
++ proxy = error "qualify"
+
+- trExp :: Exp -> R Exp
+- trExp (Lambda loc pats e) = do
+- pats' <- tr pats
+- e' <- local (\\ vars pats) $ trExp e
++ trQName :: Data loc => loc -> QName loc -> R (QName loc)
++ trQName _ y@(UnQual loc x) = do
++ b <- asks (printName loc x `elem`)
++ return $ if b then (Qual loc (ModuleName loc q) x) else y
++ trQName _ y = return y
++
++ trExp :: Data loc => loc -> Exp loc -> R (Exp loc)
++ trExp _ (Lambda loc pats e) = do
++ pats' <- tr loc pats
++ e' <- local (\\ vars loc pats) $ trExp loc e
+ return $ Lambda loc pats' e'
+- trExp (Let b e) = do
+- (b', e') <- local (\\ vars b) $ tr (b, e)
+- return $ Let b' e'
+- trExp x = gmapM tr x
++ trExp _ (Let loc b e) = do
++ (b', e') <- local (\\ vars loc b) $ tr loc (b, e)
++ return $ Let loc b' e'
++ trExp loc x = gmapM (tr loc) x
+
+ {-
+ Alt:
+ Alt SrcLoc Pat GuardedAlts Binds
+ -}
+
+- tr :: Data x => x -> R x
+- tr = everywhereM (mkM trQName) `extM` trExp
++ tr :: (Data loc, Data a) => loc -> a -> R a
++ tr loc = everywhereM (mkM (trQName loc)) `extM` (trExp loc)
+
+- vars :: Data a => a -> [String]
+- vars = map printName . everything (++) (mkQ [] patVars_)
++ vars :: (Typeable loc, Data a) => loc -> a -> [String]
++ vars loc = map (printName loc) . everything (++) (mkQ [] (patVars_ loc))
+
+- patVars_ :: Pat -> [Name]
+- patVars_ (PVar x) = [x]
+- patVars_ (PAsPat x _) = [x]
+- patVars_ (PNPlusK x _) = [x]
+- patVars_ _ = []
++ patVars_ :: loc -> Pat loc -> [Name loc]
++ patVars_ _ (PVar _ x) = [x]
++ patVars_ _ (PAsPat _ x _) = [x]
++ patVars_ _ (PNPlusK _ x _) = [x]
++ patVars_ _ _ = []
+
+- printName (Ident x) = x
+- printName (Symbol x) = x
++ printName :: loc -> Name loc -> String
++ printName _ (Ident _ x) = x
++ printName _ (Symbol _ x) = x
+
+ {- !!!
+ PatTypeSig SrcLoc Pat Type
diff --git a/www/hs-activehs/files/patch-QuickCheck.hs b/www/hs-activehs/files/patch-QuickCheck.hs
deleted file mode 100644
index 3c0c2e43857a..000000000000
--- a/www/hs-activehs/files/patch-QuickCheck.hs
+++ /dev/null
@@ -1,50 +0,0 @@
---- ./QuickCheck.hs.orig 2013-02-12 20:23:46.000000000 +0100
-+++ ./QuickCheck.hs 2014-07-14 02:54:45.000000000 +0200
-@@ -7,13 +7,14 @@
- import Logger
- import Qualify (qualify)
- import Hash
-+import Specialize (specialize)
-
- import Test.QuickCheck hiding (Result)
- import qualified Test.QuickCheck.Property as QC
-
- import Data.Char (isLower)
- import Data.List (intercalate)
--import Control.Monad (join)
-+import Control.Monad (join,forM)
- import Control.Concurrent.MVar
-
- ---------------------------------------
-@@ -38,19 +39,24 @@
- return [Error True err]
- Right s_ -> do
- logStrMsg 3 (logger ch) $ "Qualified expressions: " ++ show s_
--
-- let ts = mkTestCases [(v,s,s') | ((v,s),s')<- zip testcases s_]
-- logStrMsg 3 (logger ch) $ "Test cases: " ++ ts
--
- interp False m5 lang ch fn "" $ \a ->
-- do liftIO $ logStrMsg 3 (logger ch) "Before interpretation"
-+ do ss <- forM (testcases `zip` s_) $ \((v,s1),s2) -> do
-+ ts1 <- typeOf s1
-+ ts2 <- typeOf s2
-+ let [x1,x2] = map fixType [(s1,ts1),(s2,ts2)]
-+ return $ mkTestCase (v,x1,x2)
-+ let ts = "[" ++ intercalate ", " ss ++ "]"
-+ liftIO $ logStrMsg 3 (logger ch) $ "Test cases: " ++ ts
-+ liftIO $ logStrMsg 3 (logger ch) "Before interpretation"
- m <- interpret ts (as :: [TestCase])
- liftIO $ logStrMsg 3 (logger ch) "After interpretation"
- return $ qcs lang (logger ch) m
-
- where
-- mkTestCases ss
-- = "[" ++ intercalate ", " (map mkTestCase ss) ++ "]"
-+ fixType (s,t) =
-+ case (specialize t) of
-+ Right (st,_) | t /= st -> unwords [s, "::", st]
-+ _ -> s
-
- mkTestCase (vars, s, s2)
- = "TestCase (\\qcinner "
diff --git a/www/hs-activehs/files/patch-Simple.hs b/www/hs-activehs/files/patch-Simple.hs
deleted file mode 100644
index 585e6ef9f436..000000000000
--- a/www/hs-activehs/files/patch-Simple.hs
+++ /dev/null
@@ -1,38 +0,0 @@
---- ./Simple.hs.orig 2013-02-12 20:23:45.000000000 +0100
-+++ ./Simple.hs 2014-07-14 02:44:00.000000000 +0200
-@@ -19,9 +19,10 @@
- import Control.Concurrent (forkIO)
- import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
- import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
--import Control.Exception (SomeException, catch)
-+import Control.Exception (SomeException)
-+import qualified Control.Exception as CE
- import Control.Monad (when, forever)
--import Control.Monad.Error (MonadError, catchError)
-+import Control.Monad.Catch (catch)
- import Data.List (isPrefixOf)
- --import Prelude hiding (catch)
-
-@@ -42,7 +43,7 @@
- _ <- forkIO $ forever $ do
- logStrMsg 1 log "start interpreter"
- e <- runInterpreter (handleTask ch Nothing)
-- `catch` \(e :: SomeException) ->
-+ `CE.catch` \(e :: SomeException) ->
- return $ Left $ UnknownError "GHCi server died."
- case e of
- Left e -> logStrMsg 0 log $ "stop interpreter: " ++ show e
-@@ -95,10 +96,10 @@
- fatal (NotAllowed _) = False
- fatal _ = True
-
--catchError_fixed
-- :: MonadError InterpreterError m
-+catchError_fixed
-+ :: MonadInterpreter m
- => m a -> (InterpreterError -> m a) -> m a
--m `catchError_fixed` f = m `catchError` (f . fixError)
-+m `catchError_fixed` f = m `catch` (f . fixError)
- where
- fixError (UnknownError s)
- | Just x <- dropPrefix "GHC returned a result but said: [GhcError {errMsg =" s
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)
diff --git a/www/hs-activehs/files/patch-activehs.cabal b/www/hs-activehs/files/patch-activehs.cabal
index 01f9fac518ae..050911e6acb2 100644
--- a/www/hs-activehs/files/patch-activehs.cabal
+++ b/www/hs-activehs/files/patch-activehs.cabal
@@ -1,58 +1,41 @@
---- activehs.cabal.orig 2013-02-12 19:23:46 UTC
+--- activehs.cabal.orig 2017-07-30 10:48:49 UTC
+++ activehs.cabal
-@@ -56,37 +56,39 @@ Executable activehs
- Special
-
- Build-Depends:
-- highlighting-kate >= 0.5 && < 0.6,
-+ highlighting-kate >= 0.5 && < 0.7,
- hoogle >= 4.2.11 && < 4.3,
- dia-base >= 0.1 && < 0.2,
- dia-functions >= 0.2.1.1 && < 0.3,
+@@ -73,30 +73,30 @@ Executable activehs
activehs-base >= 0.2 && < 0.4,
data-pprint >= 0.2 && < 0.3,
-- base >= 4.0 && < 4.7,
-- QuickCheck >= 2.4 && < 2.6,
-- array >= 0.3 && < 0.5,
-+ base >= 4.0 && < 4.9,
-+ QuickCheck >= 2.4 && < 2.9,
-+ array >= 0.3 && < 0.6,
- directory >= 1.1 && < 1.3,
+ base >= 4.0 && < 5.0,
+- QuickCheck >= 2.4 && < 2.9,
++ QuickCheck >= 2.4 && < 2.11,
+ array >= 0.3 && < 0.6,
+- directory >= 1.1 && < 1.3,
++ directory >= 1.1 && < 1.4,
containers >= 0.4 && < 0.6,
-- filepath >= 1.2 && < 1.4,
-- text >= 0.11 && < 0.12,
-+ filepath >= 1.2 && < 1.5,
-+ text >= 1.1 && < 1.3,
- snap-core >= 0.6 && < 0.10,
- snap-server >= 0.6 && < 0.10,
-- syb >= 0.2 && < 0.4,
-- haskell-src-exts >= 1.12 && < 1.14,
-+ syb >= 0.2 && < 0.6,
-+ haskell-src-exts >= 1.16 && < 1.17,
+ filepath >= 1.2 && < 1.5,
+ text >= 1.1 && < 1.3,
+ snap-core >= 1.0 && < 1.1,
+ snap-server >= 1.0 && < 1.1,
+- syb >= 0.6 && < 0.7,
+- haskell-src-exts >= 1.17 && < 1.18,
++ syb >= 0.6 && < 0.8,
++ haskell-src-exts >= 1.17 && < 1.20,
bytestring >= 0.9 && < 0.11,
-- utf8-string >= 0.3 && < 0.4,
-+ utf8-string >= 0.3 && < 1.1,
+ utf8-string >= 0.3 && < 1.1,
xhtml >= 3000.2 && < 3000.3,
-- blaze-html >= 0.4 && < 0.6,
-+ blaze-html >= 0.4 && < 0.9,
-+ blaze-markup >= 0.6 && < 0.8,
+- blaze-html >= 0.6 && < 0.9,
+- blaze-markup >= 0.6 && < 0.8,
++ blaze-html >= 0.6 && < 0.10,
++ blaze-markup >= 0.6 && < 0.9,
pureMD5 >= 2.1 && < 2.2,
-- deepseq >= 1.1 && < 1.4,
-+ deepseq >= 1.1 && < 1.5,
-+ exceptions >= 0.6 && < 0.9,
+ deepseq >= 1.1 && < 1.5,
+ exceptions >= 0.6 && < 0.9,
split >= 0.1 && < 0.3,
-- pandoc >= 1.10 && < 1.11,
-- time >= 1.2 && < 1.5,
-+ pandoc >= 1.10 && < 1.16,
-+ time >= 1.2 && < 1.6,
+- pandoc >= 1.17 && < 1.18,
++ pandoc >= 1.17 && < 1.20,
+ time >= 1.6 && < 1.7,
old-time >= 1.0 && < 1.2,
-- process >= 1.0 && < 1.2,
-- hint >= 0.3.3.2 && < 0.4,
-+ process >= 1.0 && < 1.3,
-+ hint >= 0.4 && < 0.5,
+ process >= 1.4 && < 1.5,
+- hint >= 0.6 && < 0.7,
++ hint >= 0.6 && < 0.8,
simple-reflect >= 0.2 && < 0.4,
-- mtl >= 2.0 && < 2.2,
-+ mtl >= 2.0 && < 2.3,
+ mtl >= 2.0 && < 2.3,
old-locale >= 1.0 && < 1.1,
- cmdargs >= 0.7 && < 0.11
-