Update haskell-src-exts dependency

Plugin/Pl/Common.hs

@@ -105,35 +105,35 @@ maxPrec = shift + 10
 minPrec = 0
 
 -- operator precedences are needed both for parsing and prettyprinting
-operators :: [[(String, (Assoc, Int))]]
+operators :: [[(String, (Assoc (), Int))]]
 operators = (map . map . second . second $ (+shift))
-  [[inf "." AssocRight 9, inf "!!" AssocLeft 9],
-   [inf name AssocRight 8 | name <- ["^", "^^", "**"]],
-   [inf name AssocLeft 7
+  [[inf "." (AssocRight ()) 9, inf "!!" (AssocLeft ()) 9],
+   [inf name (AssocRight ()) 8 | name <- ["^", "^^", "**"]],
+   [inf name (AssocLeft ()) 7
      | name <- ["*", "/", "`quot`", "`rem`", "`div`", "`mod`", ":%", "%"]],
-   [inf name AssocLeft 6  | name <- ["+", "-"]],
-   [inf name AssocRight 5 | name <- [":", "++"]],
-   [inf name AssocNone 4 
+   [inf name (AssocLeft ()) 6  | name <- ["+", "-"]],
+   [inf name (AssocRight ()) 5 | name <- [":", "++"]],
+   [inf name (AssocNone ()) 4
      | name <- ["==", "/=", "<", "<=", ">=", ">", "`elem`", "`notElem`"]],
-   [inf "&&" AssocRight 3],
-   [inf "||" AssocRight 2],
-   [inf ">>" AssocLeft 1, inf ">>=" AssocLeft 1, inf "=<<" AssocRight 1],
-   [inf name AssocRight 0 | name <- ["$", "$!", "`seq`"]]
+   [inf "&&" (AssocRight ()) 3],
+   [inf "||" (AssocRight ()) 2],
+   [inf ">>" (AssocLeft ()) 1, inf ">>=" (AssocLeft ()) 1, inf "=<<" (AssocRight ()) 1],
+   [inf name (AssocRight ()) 0 | name <- ["$", "$!", "`seq`"]]
   ] where
   inf name assoc fx = (name, (assoc, fx))
 
 reservedOps :: [String]
 reservedOps = ["->", "..", "="]
 
-opFM :: M.Map String (Assoc, Int)
+opFM :: M.Map String (Assoc (), Int)
 opFM = (M.fromList $ concat operators)
 
-lookupOp :: String -> Maybe (Assoc, Int)
+lookupOp :: String -> Maybe (Assoc (), Int)
 lookupOp k = M.lookup k opFM
 
-lookupFix :: String -> (Assoc, Int)
+lookupFix :: String -> (Assoc (), Int)
 lookupFix str = case lookupOp $ str of
-  Nothing -> (AssocLeft, 9 + shift)
+  Nothing -> ((AssocLeft ()), 9 + shift)
   Just x  -> x
 
 readM :: (Monad m, Read a) => String -> m a

Plugin/Pl/Parser.hs

@@ -4,83 +4,83 @@ import Plugin.Pl.Common
 
 import qualified Language.Haskell.Exts as HSE
 
-todo :: (Show e) => e -> a
-todo thing = error ("pointfree: not supported: " ++ show thing)
+todo :: (Functor e, Show (e ())) => e a -> r
+todo thing = error ("pointfree: not supported: " ++ show (fmap (const ()) thing))
 
-nameString :: HSE.Name -> (Fixity, String)
-nameString (HSE.Ident s) = (Pref, s)
-nameString (HSE.Symbol s) = (Inf, s)
+nameString :: HSE.Name a -> (Fixity, String)
+nameString (HSE.Ident _ s) = (Pref, s)
+nameString (HSE.Symbol _ s) = (Inf, s)
 
-qnameString :: HSE.QName -> (Fixity, String)
-qnameString (HSE.Qual m n) = fmap ((HSE.prettyPrint m ++ ".") ++) (nameString n)
-qnameString (HSE.UnQual n) = nameString n
-qnameString (HSE.Special sc) = case sc of
-  HSE.UnitCon -> (Pref, "()")
-  HSE.ListCon -> (Pref, "[]")
-  HSE.FunCon -> (Inf, "->")
-  HSE.TupleCon HSE.Boxed n -> (Inf, replicate (n-1) ',')
+qnameString :: HSE.QName a -> (Fixity, String)
+qnameString (HSE.Qual _ m n) = fmap ((HSE.prettyPrint m ++ ".") ++) (nameString n)
+qnameString (HSE.UnQual _ n) = nameString n
+qnameString (HSE.Special _ sc) = case sc of
+  HSE.UnitCon _ -> (Pref, "()")
+  HSE.ListCon _ -> (Pref, "[]")
+  HSE.FunCon _ -> (Inf, "->")
+  HSE.TupleCon _ HSE.Boxed n -> (Inf, replicate (n-1) ',')
   HSE.TupleCon{} -> todo sc
-  HSE.Cons -> (Inf, ":")
-  HSE.UnboxedSingleCon -> todo sc
+  HSE.Cons _ -> (Inf, ":")
+  HSE.UnboxedSingleCon{} -> todo sc
 
-opString :: HSE.QOp -> (Fixity, String)
-opString (HSE.QVarOp qn) = qnameString qn
-opString (HSE.QConOp qn) = qnameString qn
+opString :: HSE.QOp a -> (Fixity, String)
+opString (HSE.QVarOp _ qn) = qnameString qn
+opString (HSE.QConOp _ qn) = qnameString qn
 
 list :: [Expr] -> Expr
 list = foldr (\y ys -> cons `App` y `App` ys) nil
 
-hseToExpr :: HSE.Exp -> Expr
+hseToExpr :: HSE.Exp a -> Expr
 hseToExpr expr = case expr of
-  HSE.Var qn -> uncurry Var (qnameString qn)
+  HSE.Var _ qn -> uncurry Var (qnameString qn)
   HSE.IPVar{} -> todo expr
-  HSE.Con qn -> uncurry Var (qnameString qn)
-  HSE.Lit l -> case l of
-    HSE.String s -> list (map (Var Pref . show) s)
+  HSE.Con _ qn -> uncurry Var (qnameString qn)
+  HSE.Lit _ l -> case l of
+    HSE.String _ _ s -> list (map (Var Pref . show) s)
     _ -> Var Pref (HSE.prettyPrint l)
-  HSE.InfixApp p op q -> apps (Var Inf (snd (opString op))) [p,q]
-  HSE.App f x -> hseToExpr f `App` hseToExpr x
-  HSE.NegApp e -> Var Pref "negate" `App` hseToExpr e
+  HSE.InfixApp _ p op q -> apps (Var Inf (snd (opString op))) [p,q]
+  HSE.App _ f x -> hseToExpr f `App` hseToExpr x
+  HSE.NegApp _ e -> Var Pref "negate" `App` hseToExpr e
   HSE.Lambda _ ps e -> foldr (Lambda . hseToPattern) (hseToExpr e) ps
-  HSE.Let bs e -> case bs of
-    HSE.BDecls ds -> Let (map hseToDecl ds) (hseToExpr e)
-    HSE.IPBinds ips -> todo ips
-  HSE.If b t f -> apps if' [b,t,f]
+  HSE.Let _ bs e -> case bs of
+    HSE.BDecls _ ds -> Let (map hseToDecl ds) (hseToExpr e)
+    HSE.IPBinds _ ips -> todo ips
+  HSE.If _ b t f -> apps if' [b,t,f]
   HSE.Case{} -> todo expr
   HSE.Do{} -> todo expr
   HSE.MDo{} -> todo expr
-  HSE.Tuple HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ','))  es
+  HSE.Tuple _ HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ','))  es
   HSE.TupleSection{} -> todo expr
-  HSE.List xs -> list (map hseToExpr xs)
-  HSE.Paren e -> hseToExpr e
-  HSE.LeftSection l op -> Var Inf (snd (opString op)) `App` hseToExpr l
-  HSE.RightSection op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r
+  HSE.List _ xs -> list (map hseToExpr xs)
+  HSE.Paren _ e -> hseToExpr e
+  HSE.LeftSection _ l op -> Var Inf (snd (opString op)) `App` hseToExpr l
+  HSE.RightSection _ op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r
   HSE.RecConstr{} -> todo expr
   HSE.RecUpdate{} -> todo expr
-  HSE.EnumFrom x -> apps (Var Pref "enumFrom") [x]
-  HSE.EnumFromTo x y -> apps (Var Pref "enumFromTo") [x,y]
-  HSE.EnumFromThen x y -> apps (Var Pref "enumFromThen") [x,y]
-  HSE.EnumFromThenTo x y z -> apps (Var Pref "enumFromThenTo") [x,y,z]
+  HSE.EnumFrom _ x -> apps (Var Pref "enumFrom") [x]
+  HSE.EnumFromTo _ x y -> apps (Var Pref "enumFromTo") [x,y]
+  HSE.EnumFromThen _ x y -> apps (Var Pref "enumFromThen") [x,y]
+  HSE.EnumFromThenTo _ x y z -> apps (Var Pref "enumFromThenTo") [x,y,z]
   _ -> todo expr
 
-apps :: Expr -> [HSE.Exp] -> Expr
+apps :: Expr -> [HSE.Exp a] -> Expr
 apps f xs = foldl (\a x -> a `App` hseToExpr x) f xs 
 
-hseToDecl :: HSE.Decl -> Decl
+hseToDecl :: HSE.Decl a -> Decl
 hseToDecl dec = case dec of
-  HSE.PatBind _ (HSE.PVar n) (HSE.UnGuardedRhs e) Nothing ->
+  HSE.PatBind _ (HSE.PVar _ n) (HSE.UnGuardedRhs _ e) Nothing ->
     Define (snd (nameString n)) (hseToExpr e)
-  HSE.FunBind [HSE.Match _ n ps Nothing (HSE.UnGuardedRhs e) Nothing] ->
+  HSE.FunBind _ [HSE.Match _ n ps (HSE.UnGuardedRhs _ e) Nothing] ->
     Define (snd (nameString n)) (foldr (\p x -> Lambda (hseToPattern p) x) (hseToExpr e) ps)
   _ -> todo dec
 
-hseToPattern :: HSE.Pat -> Pattern
+hseToPattern :: HSE.Pat a -> Pattern
 hseToPattern pat = case pat of
-  HSE.PVar n -> PVar (snd (nameString n))
-  HSE.PInfixApp l (HSE.Special HSE.Cons) r -> PCons (hseToPattern l) (hseToPattern r)
-  HSE.PTuple HSE.Boxed [p,q] -> PTuple (hseToPattern p) (hseToPattern q)
-  HSE.PParen p -> hseToPattern p
-  HSE.PWildCard -> PVar "_"
+  HSE.PVar _ n -> PVar (snd (nameString n))
+  HSE.PInfixApp _ l (HSE.Special _ (HSE.Cons _)) r -> PCons (hseToPattern l) (hseToPattern r)
+  HSE.PTuple _ HSE.Boxed [p,q] -> PTuple (hseToPattern p) (hseToPattern q)
+  HSE.PParen _ p -> hseToPattern p
+  HSE.PWildCard _ -> PVar "_"
   _ -> todo pat
 
 parsePF :: String -> Either String TopLevel

Plugin/Pl/PrettyPrinter.hs

@@ -107,13 +107,13 @@ instance Show SExpr where
     showsPrec f2 e2 where
       fixity = snd $ lookupFix fx
       (f1, f2) = case fst $ lookupFix fx of
-        AssocRight -> (fixity+1, fixity + infixSafe e2 AssocLeft fixity)
-        AssocLeft  -> (fixity + infixSafe e1 AssocRight fixity, fixity+1)
-        AssocNone  -> (fixity+1, fixity+1)
+        AssocRight _ -> (fixity+1, fixity + infixSafe e2 (AssocLeft ()) fixity)
+        AssocLeft _ -> (fixity + infixSafe e1 (AssocRight ()) fixity, fixity+1)
+        AssocNone _ -> (fixity+1, fixity+1)
 
       -- This is a little bit awkward, but at least seems to produce no false
       -- results anymore
-      infixSafe :: SExpr -> Assoc -> Int -> Int
+      infixSafe :: SExpr -> Assoc () -> Int -> Int
       infixSafe (SInfix fx'' _ _) assoc fx'
         | lookupFix fx'' == (assoc, fx') = 1
         | otherwise = 0

pointfree.cabal

@@ -29,7 +29,7 @@ Library
   Build-depends: base >= 4.5 && < 4.10,
                  array >= 0.3 && < 0.6,
                  containers >= 0.4 && < 0.6,
-                 haskell-src-exts == 1.17.*,
+                 haskell-src-exts >= 1.18 && < 1.20,
                  transformers < 0.6
   Other-modules: Plugin.Pl.Common
                  Plugin.Pl.Parser
@@ -45,7 +45,7 @@ Executable pointfree
   Build-depends: base >= 4.3 && < 4.10,
                  array >= 0.3 && < 0.6,
                  containers >= 0.4 && < 0.6,
-                 haskell-src-exts == 1.17.*,
+                 haskell-src-exts >= 1.18 && < 1.20,
                  transformers < 0.6
   Other-modules: Plugin.Pl.Common
                  Plugin.Pl.Parser
@@ -64,7 +64,7 @@ Test-suite tests
     array >= 0.3 && < 0.6,
     base < 5,
     containers >= 0.3 && < 0.6,
-    haskell-src-exts == 1.17.*,
+    haskell-src-exts >= 1.18 && < 1.20,
     HUnit >= 1.1 && < 1.4,
     QuickCheck >= 2.1 && < 2.10,
     transformers < 0.6