diff --git a/make-pages/Info.hs b/make-pages/Info.hs index a587899..584e8dd 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -16,7 +16,7 @@ import Records import Control.Applicative import Control.Exception -import Data.Foldable (find, foldl') +import Data.Foldable (find) import Data.Hashable (Hashable) import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet @@ -149,15 +149,21 @@ instance Semigroup Desc where (TextDesc t1) <> (TextDesc t2) = TextDesc $ t1 <> t2 (LongDesc m1) <> (TextDesc t2) = LongDesc $ m1 <> [DescField defDescKey t2] (TextDesc t1) <> (LongDesc m2) = LongDesc $ [DescField defDescKey t1] <> m2 - (LongDesc m1) <> (LongDesc m2) = LongDesc $ mergeDesc m1 m2 + (LongDesc m1) <> (LongDesc m2) = LongDesc $ merge m1 m2 -mergeDesc :: [DescField] -> [DescField] -> [DescField] -mergeDesc = foldl' $ flip add where - add d2 = map \d1 -> - if #name d1 == #name d2 then - d1 {text = #text d1 <> #text d2} +merge :: [DescField] -> [DescField] -> [DescField] +merge fs1 fs2 = go fs1 [] fs2 where + go first unused [] = first <> reverse unused + go first unused (x:xs) = + case insert first x of + Just first' -> go first' unused xs + Nothing -> go first (x:unused) xs + insert [] _ = Nothing + insert (x:xs) y = + if #name x == #name y then + Just $ x {text = #text x <> #text y} : xs else - d1 + (x :) <$> insert xs y instance Monoid Desc where mempty = NoDesc