From 9be0c216769b7ba31e7f6e7dca28de3c9cecd4a3 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Thu, 11 Dec 2014 16:05:42 +0000
Subject: [PATCH] GF.Grammar.Macros: generalize the type of collectOp

New type:

    collectOp :: Monoid m => (Term -> m) -> Term -> m
---
 src/compiler/GF/Grammar/Macros.hs | 39 +++++++++++++++++--------------
 1 file changed, 21 insertions(+), 18 deletions(-)

diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index 53c134396..98d784fda 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -31,7 +31,8 @@ import qualified Data.Traversable as T(mapM)
 import Control.Monad (liftM, liftM2, liftM3)
 --import Data.Char (isDigit)
 import Data.List (sortBy,nub)
-import GF.Text.Pretty
+import Data.Monoid
+import GF.Text.Pretty(render,(<+>),hsep,fsep)
 
 -- ** Functions for constructing and analysing source code terms.
 
@@ -479,26 +480,28 @@ composPattOp op patt =
     PRep p          -> liftM  PRep (op p)
     _               -> return patt -- covers cases without subpatterns
 
-collectOp :: (Term -> [a]) -> Term -> [a]
+collectOp :: Monoid m => (Term -> m) -> Term -> m
 collectOp co trm = case trm of
-  App c a      -> co c ++ co a 
+  App c a      -> co c <> co a
   Abs _ _ b    -> co b
-  Prod _ _ a b -> co a ++ co b 
-  S c a        -> co c ++ co a
-  Table a c    -> co a ++ co c
-  ExtR a c     -> co a ++ co c
-  R r          -> concatMap (\ (_,(mt,a)) -> maybe [] co mt ++ co a) r 
-  RecType r    -> concatMap (co . snd) r 
+  Prod _ _ a b -> co a <> co b
+  S c a        -> co c <> co a
+  Table a c    -> co a <> co c
+  ExtR a c     -> co a <> co c
+  R r          -> mconcatMap (\ (_,(mt,a)) -> maybe mempty co mt <> co a) r
+  RecType r    -> mconcatMap (co . snd) r
   P t i        -> co t
-  T _ cc       -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
-  V _ cc       -> concatMap co         cc --- nor from type annot
-  Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b
-  C s1 s2      -> co s1 ++ co s2 
-  Glue s1 s2   -> co s1 ++ co s2 
-  Alts t aa    -> let (x,y) = unzip aa in co t ++ concatMap co (x ++ y)
-  FV ts        -> concatMap co ts
-  Strs tt      -> concatMap co tt
-  _            -> [] -- covers K, Vr, Cn, Sort
+  T _ cc       -> mconcatMap (co . snd) cc -- not from patterns --- nor from type annot
+  V _ cc       -> mconcatMap co         cc --- nor from type annot
+  Let (x,(mt,a)) b -> maybe mempty co mt <> co a <> co b
+  C s1 s2      -> co s1 <> co s2
+  Glue s1 s2   -> co s1 <> co s2
+  Alts t aa    -> let (x,y) = unzip aa in co t <> mconcatMap co (x <> y)
+  FV ts        -> mconcatMap co ts
+  Strs tt      -> mconcatMap co tt
+  _            -> mempty -- covers K, Vr, Cn, Sort
+
+mconcatMap f = mconcat . map f
 
 collectPattOp :: (Patt -> [a]) -> Patt -> [a]
 collectPattOp op patt =