merge same-named sections in desc and nsfw-desc
This commit is contained in:
parent
0e88d0cab2
commit
85199c1105
2 changed files with 11 additions and 2 deletions
|
@ -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
|
||||
|
|
|
@ -35,6 +35,7 @@ executable make-pages
|
|||
DerivingStrategies,
|
||||
DerivingVia,
|
||||
DuplicateRecordFields,
|
||||
FlexibleContexts,
|
||||
FlexibleInstances,
|
||||
GeneralizedNewtypeDeriving,
|
||||
LambdaCase,
|
||||
|
|
Loading…
Reference in a new issue