haskell-src-exts 1.6.1 → 1.7.0

raw patch · 6 files changed

+41/−23 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskell-src-exts.cabal +1/−1
• src/Language/Haskell/Exts/Annotated/ExactPrint.hs +16/−6
• src/Language/Haskell/Exts/Annotated/Fixity.hs +1/−1
• src/Language/Haskell/Exts/Annotated/Simplify.hs +2/−2
• src/Language/Haskell/Exts/Annotated/Syntax.hs +3/−3
• src/Language/Haskell/Exts/ParseUtils.hs +18/−10

@@ -1,5 +1,5 @@ Name:                   haskell-src-exts-Version:                1.6.1+Version:                1.7.0 License:                BSD3 License-File:           LICENSE Author:                 Niklas Broberg

@@ -1418,17 +1418,27 @@ instance ExactP Match where
   exactP (Match l n ps rhs mbinds) = do
     let pts = srcInfoPoints l
-    exactP n
-    mapM_ exactPC ps
+        len = length pts
+        pars = len `div` 2
+        (oPars,cParsWh) = splitAt pars pts
+        (cPars,whPt) = splitAt pars cParsWh    -- whPt is either singleton or empty
+    printStrs (zip oPars (repeat "("))
+    exactPC n
+    printStreams (zip (map pos cPars) (repeat $ printString ")")) (map (pos . ann &&& exactPC) ps) 
     exactPC rhs
     maybeEP (\bds -> printStringAt (pos (head pts)) "where" >> exactPC bds) mbinds
-  exactP (InfixMatch l a n b rhs mbinds) = do
+  exactP (InfixMatch l a n bs rhs mbinds) = do
     let pts = srcInfoPoints l
-    exactP a
+        len = length pts
+        pars = len `div` 2
+        (oPars,cParsWh) = splitAt pars pts
+        (cPars,whPt) = splitAt pars cParsWh    -- whPt is either singleton or empty
+    printStrs (zip oPars (repeat "("))
+    exactPC a
     epInfixName n
-    exactPC b
+    printInterleaved' (zip cPars (repeat ")")) bs
     exactPC rhs
-    maybeEP (\bds -> printStringAt (pos (head pts)) "where" >> exactPC bds) mbinds
+    maybeEP (\bds -> printStringAt (pos (head whPt)) "where" >> exactPC bds) mbinds
 
 instance ExactP Rhs where
   exactP (UnGuardedRhs l e) = printString "=" >> exactPC e

@@ -166,7 +166,7 @@ instance AppFixity Match where
     applyFixities fixs match = case match of
         Match l n ps rhs bs -> liftM3 (Match l n) (mapM fix ps) (fix rhs) (mapM fix bs)
-        InfixMatch l a n b rhs bs -> liftM4 (flip (InfixMatch l) n) (fix a) (fix b) (fix rhs) (mapM fix bs)
+        InfixMatch l a n ps rhs bs -> liftM4 (flip (InfixMatch l) n) (fix a) (mapM fix ps) (fix rhs) (mapM fix bs)
       where fix x = applyFixities fixs x
 
 instance AppFixity Rhs where

@@ -208,8 +208,8 @@ sMatch :: SrcInfo loc => Match loc -> S.Match
 sMatch (Match l n ps rhs mwhere) =
     S.Match (getPointLoc l) (sName n) (map sPat ps) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere)
-sMatch (InfixMatch l pa n pb rhs mwhere) =
-    S.Match (getPointLoc l) (sName n) (map sPat [pa,pb]) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere)
+sMatch (InfixMatch l pa n pbs rhs mwhere) =
+    S.Match (getPointLoc l) (sName n) (map sPat (pa:pbs)) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere)
 
 sQualConDecl :: SrcInfo loc => QualConDecl loc -> S.QualConDecl
 sQualConDecl (QualConDecl l mtvs mctxt cd) =

@@ -446,7 +446,7 @@ -- | Clauses of a function binding. data Match l      = Match l      (Name l) [Pat l]         (Rhs l) {-where-} (Maybe (Binds l))-     | InfixMatch l (Pat l) (Name l) (Pat l) (Rhs l) {-where-} (Maybe (Binds l))+     | InfixMatch l (Pat l) (Name l) [Pat l] (Rhs l) {-where-} (Maybe (Binds l)) #ifdef __GLASGOW_HASKELL__   deriving (Eq,Ord,Show,Typeable,Data) #else@@ -1250,8 +1250,8 @@ instance Functor Match where     fmap f (Match l n ps rhs bs) =         Match (f l) (fmap f n) (map (fmap f) ps) (fmap f rhs) (fmap (fmap f) bs)-    fmap f (InfixMatch l a n b rhs bs) =-        InfixMatch (f l) (fmap f a) (fmap f n) (fmap f b) (fmap f rhs) (fmap (fmap f) bs)+    fmap f (InfixMatch l a n ps rhs bs) =+        InfixMatch (f l) (fmap f a) (fmap f n) (map (fmap f) ps) (fmap f rhs) (fmap (fmap f) bs)  instance Functor QualConDecl where     fmap f (QualConDecl l mtvs mcx cd) = QualConDecl (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f cd)

@@ -665,13 +665,16 @@ checkValDef :: L -> PExp L -> Maybe (S.Type L) -> Rhs L -> Maybe (Binds L) -> P (Decl L) checkValDef l lhs optsig rhs whereBinds = do     mlhs <- isFunLhs lhs []+    let whpt = srcInfoPoints l     case mlhs of-     Just (f,es,b) -> do+     Just (f,es,b,pts) -> do             ps <- mapM checkPattern es+            let l' = l { srcInfoPoints = pts ++ whpt }             case optsig of -- only pattern bindings can have signatures                 Nothing -> return (FunBind l $-                            if b then [Match l f ps rhs whereBinds]-                                 else let [a,b] = ps in [InfixMatch l a f b rhs whereBinds])+                            if b then [Match l' f ps rhs whereBinds]+                                 else let (a:bs) = ps +                                       in [InfixMatch l' a f bs rhs whereBinds])                 Just _  -> fail "Cannot give an explicit type signature to a function binding"      Nothing     -> do             lhs <- checkPattern lhs@@ -679,19 +682,24 @@  -- A variable binding is parsed as a PatBind. -isFunLhs :: PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool))-isFunLhs (InfixApp _ l (QVarOp loc (UnQual _ op)) r) es+isFunLhs :: PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [S]))+isFunLhs (InfixApp ll l (QVarOp loc (UnQual _ op)) r) es     | op =~= (Symbol () "!") = do         exts <- getExtensions         if BangPatterns `elem` exts          then let (b,bs) = splitBang r []                in isFunLhs l (BangPat loc b : bs ++ es)-         else return $ Just (op, l:r:es, False) -- It's actually a definition of the operator !-    | otherwise = return $ Just (op, l:r:es, False)-isFunLhs (App _ (Var _ (UnQual _ f)) e) es = return $ Just (f, e:es, True)+         else return $ Just (op, l:r:es, False, []) -- It's actually a definition of the operator !+    | otherwise = return $ Just (op, l:r:es, False, [])+isFunLhs (App _ (Var _ (UnQual _ f)) e) es = return $ Just (f, e:es, True, []) isFunLhs (App _ f e) es = isFunLhs f (e:es)-isFunLhs (Var _ (UnQual _ f)) es@(_:_) = return $ Just (f, es, True)-isFunLhs (Paren _ f) es@(_:_) = isFunLhs f es+isFunLhs (Var _ (UnQual _ f)) es@(_:_) = return $ Just (f, es, True, [])+isFunLhs (Paren l f) es@(_:_) = do mlhs <- isFunLhs f es +                                   case mlhs of+                                    Just (f,es,b,pts) -> +                                       let [x,y] = srcInfoPoints l+                                        in return $ Just (f,es,b,x:pts++[y])+                                    _ -> return Nothing isFunLhs _ _ = return Nothing  -- Separating between signature declarations and value definitions in