Hello community,
here is the log from the commit of package pointful for openSUSE:Factory checked in at 2017-04-13 10:44:48
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/pointful (Old)
and /work/SRC/openSUSE:Factory/.pointful.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "pointful"
Thu Apr 13 10:44:48 2017 rev:7 rq:461708 version:1.0.9
Changes:
--------
--- /work/SRC/openSUSE:Factory/pointful/pointful.changes 2016-10-22 13:22:04.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.pointful.new/pointful.changes 2017-04-13 10:44:49.807463296 +0200
@@ -1,0 +2,5 @@
+Sun Feb 12 14:16:38 UTC 2017 - psimons@suse.com
+
+- Update to version 1.0.9 revision 1 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
pointful-1.0.8.tar.gz
New:
----
pointful-1.0.9.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ pointful.spec ++++++
--- /var/tmp/diff_new_pack.YzU1SS/_old 2017-04-13 10:44:50.383381852 +0200
+++ /var/tmp/diff_new_pack.YzU1SS/_new 2017-04-13 10:44:50.383381852 +0200
@@ -1,7 +1,7 @@
#
# spec file for package pointful
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -18,7 +18,7 @@
%global pkg_name pointful
Name: %{pkg_name}
-Version: 1.0.8
+Version: 1.0.9
Release: 0
Summary: Pointful refactoring tool
License: BSD-3-Clause
@@ -26,9 +26,10 @@
Url: https://hackage.haskell.org/package/%{name}
Source0: https://hackage.haskell.org/package/%{name}-%{version}/%{name}-%{version}.tar.gz
Source1: https://hackage.haskell.org/package/%{name}-%{version}/revision/1.cabal#/%{name}.cabal
+BuildRequires: chrpath
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-containers-devel
-BuildRequires: ghc-haskell-src-exts-devel
+BuildRequires: ghc-haskell-src-exts-simple-devel
BuildRequires: ghc-mtl-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-syb-devel
@@ -65,6 +66,7 @@
%install
%ghc_lib_install
+%ghc_fix_rpath %{pkg_name}-%{version}
%post -n ghc-%{name}-devel
%ghc_pkg_recache
++++++ pointful-1.0.8.tar.gz -> pointful-1.0.9.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointful-1.0.8/Lambdabot/Parser.hs new/pointful-1.0.9/Lambdabot/Parser.hs
--- old/pointful-1.0.8/Lambdabot/Parser.hs 2016-05-25 18:23:20.000000000 +0200
+++ new/pointful-1.0.9/Lambdabot/Parser.hs 2016-08-06 21:11:49.000000000 +0200
@@ -8,7 +8,7 @@
) where
import Data.Generics
-import Language.Haskell.Exts
+import Language.Haskell.Exts.Simple
-- |Parse a string as an 'Exp' or a 'Decl', apply the given generic transformation to it,
-- and re-render it back to text.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointful-1.0.8/Lambdabot/Pointful.hs new/pointful-1.0.9/Lambdabot/Pointful.hs
--- old/pointful-1.0.8/Lambdabot/Pointful.hs 2016-05-25 18:23:20.000000000 +0200
+++ new/pointful-1.0.9/Lambdabot/Pointful.hs 2016-08-06 21:11:49.000000000 +0200
@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
-- Undo pointfree transformations. Plugin code derived from Pl.hs.
module Lambdabot.Pointful (pointful) where
@@ -13,21 +14,18 @@
import qualified Data.Map as M
import Data.List
import Data.Maybe
-import Language.Haskell.Exts as Hs
+import Language.Haskell.Exts.Simple as Hs
---- Utilities ----
-unkLoc :: SrcLoc
-unkLoc = SrcLoc "<new>" 1 1
-
stabilize :: Eq a => (a -> a) -> a -> a
stabilize f x = let x' = f x in if x' == x then x else stabilize f x'
-- varsBoundHere returns variables bound by top patterns or binders
varsBoundHere :: Data d => d -> S.Set Name
varsBoundHere (cast -> Just (PVar name)) = S.singleton name
-varsBoundHere (cast -> Just (Match _ name _ _ _ _)) = S.singleton name
-varsBoundHere (cast -> Just (PatBind _ pat _ _)) = varsBoundHere pat
+varsBoundHere (cast -> Just (Match name _ _ _)) = S.singleton name
+varsBoundHere (cast -> Just (PatBind pat _ _)) = varsBoundHere pat
varsBoundHere (cast -> Just (_ :: Exp)) = S.empty
varsBoundHere d = S.unions (gmapQ varsBoundHere d)
@@ -40,15 +38,15 @@
go :: forall d. Data d => d -> Reader (S.Set Name) a
go (cast -> Just (Var (UnQual name))) =
asks (var name)
- go (cast -> Just (Lambda _ ps exp)) =
+ go (cast -> Just (Lambda ps exp)) =
bind [varsBoundHere ps] $ go exp
go (cast -> Just (Let bs exp)) =
bind [varsBoundHere bs] $ collect [go bs, go exp]
- go (cast -> Just (Alt _ pat exp bs)) =
+ go (cast -> Just (Alt pat exp bs)) =
bind [varsBoundHere pat, varsBoundHere bs] $ collect [go exp, go bs]
- go (cast -> Just (PatBind _ pat exp bs)) =
+ go (cast -> Just (PatBind pat exp bs)) =
bind [varsBoundHere pat, varsBoundHere bs] $ collect [go exp, go bs]
- go (cast -> Just (Match _ _ ps _ exp bs)) =
+ go (cast -> Just (Match _ ps exp bs)) =
bind [varsBoundHere ps, varsBoundHere bs] $ collect [go exp, go bs]
go d = collect (gmapQ go d)
@@ -76,28 +74,28 @@
exp e@(Var (UnQual name)) =
fromMaybe e (M.lookup name subst)
- exp (Lambda sloc ps exp) =
+ exp (Lambda ps exp) =
let (subst', bv', ps') = renameBinds subst bv ps
- in Lambda sloc ps' (substAvoiding subst' bv' exp)
+ in Lambda ps' (substAvoiding subst' bv' exp)
exp (Let bs exp) =
let (subst', bv', bs') = renameBinds subst bv bs
in Let (substAvoiding subst' bv' bs') (substAvoiding subst' bv' exp)
exp d = base d
- alt (Alt sloc pat exp bs) =
+ alt (Alt pat exp bs) =
let (subst1, bv1, pat') = renameBinds subst bv pat
(subst', bv', bs') = renameBinds subst1 bv1 bs
- in Alt sloc pat' (substAvoiding subst' bv' exp) (substAvoiding subst' bv' bs')
+ in Alt pat' (substAvoiding subst' bv' exp) (substAvoiding subst' bv' bs')
- decl (PatBind sloc pat exp bs) =
+ decl (PatBind pat exp bs) =
let (subst', bv', bs') = renameBinds subst bv bs in
- PatBind sloc pat (substAvoiding subst' bv' exp) (substAvoiding subst' bv' bs')
+ PatBind pat (substAvoiding subst' bv' exp) (substAvoiding subst' bv' bs')
decl d = base d
- match (Match sloc name ps typ exp bs) =
+ match (Match name ps exp bs) =
let (subst1, bv1, ps') = renameBinds subst bv ps
(subst', bv', bs') = renameBinds subst1 bv1 bs
- in Match sloc name ps' typ (substAvoiding subst' bv' exp) (substAvoiding subst' bv' bs')
+ in Match name ps' (substAvoiding subst' bv' exp) (substAvoiding subst' bv' bs')
-- rename local binders (but not the nested expressions)
renameBinds :: Data d => M.Map Name Exp -> S.Set Name -> d -> (M.Map Name Exp, S.Set Name, d)
@@ -111,13 +109,13 @@
pat (PVar name) = PVar `fmap` rename name
pat d = base d
- match (Match sloc name ps typ exp bs) = do
+ match (Match name ps exp bs) = do
name' <- rename name
- return $ Match sloc name' ps typ exp bs
+ return $ Match name' ps exp bs
- decl (PatBind sloc pat exp bs) = do
+ decl (PatBind pat exp bs) = do
pat' <- go pat
- return $ PatBind sloc pat' exp bs
+ return $ PatBind pat' exp bs
decl d = base d
exp (e :: Exp) = return e
@@ -151,15 +149,15 @@
-- move lambda patterns into LHS
optimizeD :: Decl -> Decl
-optimizeD (PatBind locat (PVar fname) (UnGuardedRhs (Lambda _ pats rhs)) Nothing) =
+optimizeD (PatBind (PVar fname) (UnGuardedRhs (Lambda pats rhs)) Nothing) =
let (subst, bv, pats') = renameBinds M.empty (S.singleton fname) pats
rhs' = substAvoiding subst bv rhs
- in FunBind [Match locat fname pats' Nothing (UnGuardedRhs rhs') Nothing]
+ in FunBind [Match fname pats' (UnGuardedRhs rhs') Nothing]
---- combine function binding and lambda
-optimizeD (FunBind [Match locat fname pats1 Nothing (UnGuardedRhs (Lambda _ pats2 rhs)) Nothing]) =
+optimizeD (FunBind [Match fname pats1 (UnGuardedRhs (Lambda pats2 rhs)) Nothing]) =
let (subst, bv, pats2') = renameBinds M.empty (varsBoundHere pats1) pats2
rhs' = substAvoiding subst bv rhs
- in FunBind [Match locat fname (pats1 ++ pats2') Nothing (UnGuardedRhs rhs') Nothing]
+ in FunBind [Match fname (pats1 ++ pats2') (UnGuardedRhs rhs') Nothing]
optimizeD x = x
-- remove parens
@@ -169,23 +167,23 @@
optimizeE :: Exp -> Exp
-- apply ((\x z -> ...x...) y) yielding (\z -> ...y...) if there is only one x or y is simple
-optimizeE (App (Lambda locat (PVar ident : pats) body) arg) | single || simple arg =
+optimizeE (App (Lambda (PVar ident : pats) body) arg) | single || simple arg =
let (subst, bv, pats') = renameBinds (M.singleton ident arg) (freeVars arg) pats
- in Paren (Lambda locat pats' (substAvoiding subst bv body))
+ in Paren (Lambda pats' (substAvoiding subst bv body))
where
single = countOcc ident body <= 1
simple e = case e of Var _ -> True; Lit _ -> True; Paren e' -> simple e'; _ -> False
-- apply ((\_ z -> ...) y) yielding (\z -> ...)
-optimizeE (App (Lambda locat (PWildCard : pats) body) _) =
- Paren (Lambda locat pats body)
+optimizeE (App (Lambda (PWildCard : pats) body) _) =
+ Paren (Lambda pats body)
-- remove 0-arg lambdas resulting from application rules
-optimizeE (Lambda _ [] b) =
+optimizeE (Lambda [] b) =
b
-- replace (\x -> \y -> z) with (\x y -> z)
-optimizeE (Lambda locat p1 (Lambda _ p2 body)) =
+optimizeE (Lambda p1 (Lambda p2 body)) =
let (subst, bv, p2') = renameBinds M.empty (varsBoundHere p1) p2
body' = substAvoiding subst bv body
- in Lambda locat (p1 ++ p2') body'
+ in Lambda (p1 ++ p2') body'
-- remove double parens
optimizeE (Paren (Paren x)) =
Paren x
@@ -193,15 +191,15 @@
optimizeE (App (Paren (x@Lambda{})) y) =
App x y
-- remove lambda body parens
-optimizeE (Lambda l p (Paren x)) =
- Lambda l p x
+optimizeE (Lambda p (Paren x)) =
+ Lambda p x
-- remove var, lit parens
optimizeE (Paren x@(Var _)) =
x
optimizeE (Paren x@(Lit _)) =
x
-- remove infix+lambda parens
-optimizeE (InfixApp a o (Paren l@(Lambda _ _ _))) =
+optimizeE (InfixApp a o (Paren l@(Lambda _ _))) =
InfixApp a o l
-- remove infix+app aprens
optimizeE (InfixApp (Paren a@App{}) o l) =
@@ -215,8 +213,8 @@
optimizeE (App (App (Var name'@(UnQual (Symbol _))) l) r) =
(InfixApp l (QVarOp name') r)
-- eta reduce
-optimizeE (Lambda l ps@(_:_) (App e (Var (UnQual v))))
- | free && last ps == PVar v = Lambda l (init ps) e
+optimizeE (Lambda ps@(_:_) (App e (Var (UnQual v))))
+ | free && last ps == PVar v = Lambda (init ps) e
where free = countOcc v e == 0
-- fail
optimizeE x = x
@@ -230,10 +228,10 @@
-- eliminate sections
uncomb' (RightSection op' arg) =
let a = freshNameAvoiding (Ident "a") (freeVars arg)
- in (Paren (Lambda unkLoc [PVar a] (InfixApp (Var (UnQual a)) op' arg)))
+ in (Paren (Lambda [PVar a] (InfixApp (Var (UnQual a)) op' arg)))
uncomb' (LeftSection arg op') =
let a = freshNameAvoiding (Ident "a") (freeVars arg)
- in (Paren (Lambda unkLoc [PVar a] (InfixApp arg op' (Var (UnQual a)))))
+ in (Paren (Lambda [PVar a] (InfixApp arg op' (Var (UnQual a)))))
-- infix to prefix for canonicality
uncomb' (InfixApp lf (QVarOp name') rf) =
(Paren (App (App (Var name') (Paren lf)) (Paren rf)))
@@ -245,13 +243,13 @@
uncomb' (App (Var (UnQual (Symbol ">>="))) (Paren lam@Lambda{})) =
let a = freshNameAvoiding (Ident "a") (freeVars lam)
b = freshNameAvoiding (Ident "b") (freeVars lam)
- in (Paren (Lambda unkLoc [PVar a, PVar b]
+ in (Paren (Lambda [PVar a, PVar b]
(App (App (Var (UnQual a)) (Paren (App lam (Var (UnQual b))))) (Var (UnQual b)))))
-- rewrite: ((>>=) e1) (\x y -> e2)
-- to: (\a -> (\x y -> e2) (e1 a) a)
-uncomb' (App (App (Var (UnQual (Symbol ">>="))) e1) (Paren lam@(Lambda _ (_:_:_) _))) =
+uncomb' (App (App (Var (UnQual (Symbol ">>="))) e1) (Paren lam@(Lambda (_:_:_) _))) =
let a = freshNameAvoiding (Ident "a") (freeVars [e1,lam])
- in (Paren (Lambda unkLoc [PVar a]
+ in (Paren (Lambda [PVar a]
(App (App lam (App e1 (Var (UnQual a)))) (Var (UnQual a)))))
-- fail
@@ -261,9 +259,9 @@
combinators :: M.Map Name Exp
combinators = M.fromList $ map declToTuple defs
where defs = case parseModule combinatorModule of
- ParseOk (Hs.Module _ _ _ _ _ _ d) -> d
+ ParseOk (Hs.Module _ _ _ d) -> d
f@(ParseFailed _ _) -> error ("Combinator loading: " ++ show f)
- declToTuple (PatBind _ (PVar fname) (UnGuardedRhs body) Nothing)
+ declToTuple (PatBind (PVar fname) (UnGuardedRhs body) Nothing)
= (fname, Paren body)
declToTuple _ = error "Pointful Plugin error: can't convert declaration to tuple"
@@ -303,3 +301,17 @@
pointful :: String -> String
pointful = withParsed (stabilize (optimize . uncomb) . stabilize (unfoldCombinators . uncomb))
+
+-- TODO: merge this into a proper test suite once one exists
+-- test s = case parseModule s of
+-- f@(ParseFailed _ _) -> fail (show f)
+-- ParseOk (Hs.Module _ _ _ _ _ _ defs) ->
+-- flip mapM_ defs $ \def -> do
+-- putStrLn . prettyPrintInLine $ def
+-- putStrLn . prettyPrintInLine . uncomb $ def
+-- putStrLn . prettyPrintInLine . optimize . uncomb $ def
+-- putStrLn . prettyPrintInLine . stabilize (optimize . uncomb) $ def
+-- putStrLn ""
+--
+-- main = test "f = tail . head; g = head . tail; h = tail + tail; three = g . h . i; dontSub = (\\x -> x + x) 1; ofHead f = f . head; fm = flip mapM_ xs (\\x -> g x); po = (+1); op = (1+); g = (. f); stabilize = fix (ap . flip (ap . (flip =<< (if' .) . (==))) =<<)"
+--
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointful-1.0.8/Pointful.hs new/pointful-1.0.9/Pointful.hs
--- old/pointful-1.0.8/Pointful.hs 2016-05-25 18:23:20.000000000 +0200
+++ new/pointful-1.0.9/Pointful.hs 1970-01-01 01:00:00.000000000 +0100
@@ -1,17 +0,0 @@
-module Main
- where
-
-import Data.List (intersperse)
-import System.Environment (getArgs)
-
-import Lambdabot.Pointful (pointful)
-
-printUsage :: IO ()
-printUsage = putStrLn "Usage: pointful QUERY"
-
-main :: IO ()
-main = do query <- getArgs
- if null query
- then printUsage
- else let query' = concat $ intersperse " " query
- in putStrLn $ pointful query'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointful-1.0.8/main/Pointful.hs new/pointful-1.0.9/main/Pointful.hs
--- old/pointful-1.0.8/main/Pointful.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/pointful-1.0.9/main/Pointful.hs 2016-08-06 21:11:49.000000000 +0200
@@ -0,0 +1,17 @@
+module Main
+ where
+
+import Data.List (intersperse)
+import System.Environment (getArgs)
+
+import Lambdabot.Pointful (pointful)
+
+printUsage :: IO ()
+printUsage = putStrLn "Usage: pointful QUERY"
+
+main :: IO ()
+main = do query <- getArgs
+ if null query
+ then printUsage
+ else let query' = concat $ intersperse " " query
+ in putStrLn $ pointful query'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointful-1.0.8/pointful.cabal new/pointful-1.0.9/pointful.cabal
--- old/pointful-1.0.8/pointful.cabal 2016-05-25 18:23:20.000000000 +0200
+++ new/pointful-1.0.9/pointful.cabal 2016-08-06 21:11:49.000000000 +0200
@@ -1,5 +1,5 @@
name: pointful
-version: 1.0.8
+version: 1.0.9
synopsis: Pointful refactoring tool
@@ -13,24 +13,20 @@
maintainer: Mikhail Glushenkov