merge same-named sections in desc and nsfw-desc

This commit is contained in:
Rhiannon Morris 2021-03-08 00:14:19 +01:00
parent 0e88d0cab2
commit 85199c1105
2 changed files with 11 additions and 2 deletions

View file

@ -16,7 +16,7 @@ import Records
import Control.Applicative import Control.Applicative
import Control.Exception import Control.Exception
import Data.Foldable (find) import Data.Foldable (find, foldl')
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
@ -149,7 +149,15 @@ instance Semigroup Desc where
(TextDesc t1) <> (TextDesc t2) = TextDesc $ t1 <> t2 (TextDesc t1) <> (TextDesc t2) = TextDesc $ t1 <> t2
(LongDesc m1) <> (TextDesc t2) = LongDesc $ m1 <> [DescField defDescKey t2] (LongDesc m1) <> (TextDesc t2) = LongDesc $ m1 <> [DescField defDescKey t2]
(TextDesc t1) <> (LongDesc m2) = LongDesc $ [DescField defDescKey t1] <> m2 (TextDesc t1) <> (LongDesc m2) = LongDesc $ [DescField defDescKey t1] <> m2
(LongDesc m1) <> (LongDesc m2) = LongDesc $ m1 <> m2 (LongDesc m1) <> (LongDesc m2) = LongDesc $ mergeDesc 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}
else
d1
instance Monoid Desc where instance Monoid Desc where
mempty = NoDesc mempty = NoDesc

View file

@ -35,6 +35,7 @@ executable make-pages
DerivingStrategies, DerivingStrategies,
DerivingVia, DerivingVia,
DuplicateRecordFields, DuplicateRecordFields,
FlexibleContexts,
FlexibleInstances, FlexibleInstances,
GeneralizedNewtypeDeriving, GeneralizedNewtypeDeriving,
LambdaCase, LambdaCase,