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.Exception
import Data.Foldable (find)
import Data.Foldable (find, foldl')
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
@ -149,7 +149,15 @@ 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 $ 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
mempty = NoDesc

View file

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