From 1aeeba9ecb7fc79062c16e00536ec8500632aab2 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 13 Mar 2022 16:42:30 +0100 Subject: [PATCH] Shared: define ordNub as alias for nubOrd from containers package (#7963) This requires at least containers 0.6.0.1, which ships with the oldest GHC version currently supported by pandoc (GHC 8.6). --- pandoc.cabal | 2 +- src/Text/Pandoc/Shared.hs | 11 +++++------ 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/pandoc.cabal b/pandoc.cabal index 4269eadac..25858d3f4 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -472,7 +472,7 @@ library commonmark-extensions >= 0.2.3 && < 0.3, commonmark-pandoc >= 0.2.1.2 && < 0.3, connection >= 0.3.1, - containers >= 0.4.2.1 && < 0.7, + containers >= 0.6.0.1 && < 0.7, data-default >= 0.4 && < 0.8, deepseq >= 1.3 && < 1.5, directory >= 1.2.3 && < 1.4, diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 26c922a04..95a422287 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -105,6 +105,7 @@ import qualified Data.Bifunctor as Bifunctor import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum, generalCategory, GeneralCategory(NonSpacingMark, SpacingCombiningMark, EnclosingMark, ConnectorPunctuation)) +import Data.Containers.ListUtils (nubOrd) import Data.List (find, intercalate, intersperse, sortOn, foldl') import qualified Data.Map as M import Data.Maybe (mapMaybe, fromMaybe) @@ -174,14 +175,12 @@ splitAt' n xs | n <= 0 = ([],xs) splitAt' n (x:xs) = (x:ys,zs) where (ys,zs) = splitAt' (n - charWidth x) xs +-- | Remove duplicates from a list. ordNub :: (Ord a) => [a] -> [a] -ordNub l = go Set.empty l - where - go _ [] = [] - go s (x:xs) = if x `Set.member` s then go s xs - else x : go (Set.insert x s) xs +ordNub = nubOrd +{-# INLINE ordNub #-} --- | Returns the last element in a foldable structure for that the +-- | Returns the first element in a foldable structure for that the -- monadic predicate holds true, and @Nothing@ if no such element -- exists. findM :: forall m t a. (Monad m, Foldable t)