Status of nubOrd (Proposal #2629)

Gwern Branwen gwern0 at gmail.com
Wed Feb 24 15:23:59 EST 2010


On Sun, Oct 5, 2008 at 11:07 PM, David Menendez <dave at zednenem.com> wrote:
> On Sat, Oct 4, 2008 at 3:26 AM, Bart Massey <bart at cs.pdx.edu> wrote:
>> I need to know what the community wants me to do to close
>> out my proposal to add nubOrd to the standard libraries.
>> After ruling out a lot of marginal choices, I guess I see
>> three leading alternatives, all of which have negatives.
>> I'd love to have some feedback on these so I can start
>> thinking about other things.
>
> I realize I'm coming into this discussion late, but has anyone
> surveyed existing Haskell code to see how often nub is used? How many
> of those cases require the specific functionality of nub, as opposed
> to something like "Set.toList . Set.fromList"? I may be misjudging
> things, but I can't imagine it's often enough to justify three or more
> implementations in the standard library.
>
> If there are really a lot of cases where people need a collection that
> (1) has no duplicates, and (2) preserves an arbitrary order of
> elements, maybe we'd be better off designing a data structure
> specifically for that.
>
> --
> Dave Menendez <dave at zednenem.com>


nub . sort (and the reverse) are very frequent. The attached sort.txt
was produced by

   find bin/ -name "*.hs" -exec sh -c "grep sort {} | grep nub && echo
{}" \; > sort.txt

It's very crude and obviously produces lots of false positives &
negatives, but even so, there's at least >50 uses of nub . sort etc.

-- 
gwern
-------------- next part --------------
        fixFromChars op = case sort (nub (intersect op "+-*/<>")) of
bin/timber/src/Fixity.hs
        transClose (c,(cs,ss))  = (c, sort (ss ++ nub(concat (map (selectors [c]) cs))))
bin/timber/src/Desugar1.hs
        fixFromChars op = case sort (nub (intersect op "+-*/<>")) of
bin/timber/_darcs/pristine/src/Fixity.hs
        transClose (c,(cs,ss))  = (c, sort (ss ++ nub(concat (map (selectors [c]) cs))))
bin/timber/_darcs/pristine/src/Desugar1.hs
import List (sort, nub)
  (nub . sort) flags == toFlags (fromFlags flags)
bin/gtk2hs/_darcs/pristine/glib/System/Glib/Flags.hs
import Data.List as List (nub, isPrefixOf, sortBy)
bin/gtk2hs/_darcs/pristine/tools/apidiff/HiDiff.hs
import List (sort, nub)
  (nub . sort) flags == toFlags (fromFlags flags)
bin/gtk2hs/glib/System/Glib/Flags.hs
import Data.List as List (nub, isPrefixOf, sortBy)
bin/gtk2hs/tools/apidiff/HiDiff.hs
import Data.List            (nub,sort,sortBy,group,sort,intersperse,genericLength)
bin/xmonad-bluetile/tests/Properties.hs
prop_nubSort l = forAll (nubl l) $ \l0 -> sort (nub l0) == Nub.nubSort l0
bin/nub/NubTests.hs
nubSort = map head . group . sort
bin/nub/Nub.hs
import Data.List (intersect, intersperse, intercalate, sort, nub, sortBy, isSuffixOf, find, isPrefixOf)
bin/meta-gitit/MetaGitit/Serve.hs
snub x = sort (nub x)
bin/yhc/Make/Useful.hs
                  contentions = nub (gc sortedNames)
bin/yhc/tests/nofib/real/anna/LambdaLift5.hs
   = let typeVars = sort (nub (tcTvars_in texpr))
bin/yhc/tests/nofib/real/anna/TExpr2DExpr.hs
-- sorted nub
snub = map head . group . sort
bin/yhc/src/libraries/core/Yhc/Core/FreeVar.hs
    snub, snubFst, snubUnder, smerge, sortFst, groupFst, foldl',
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
-- | sorted nub of list based on function of values
snubUnder f = map head . groupUnder f . sortUnder f
bin/yhc/src/interactive/GenUtil.hs
        tests = sort $ nub $ map (fst . fst) items
        dates = sort $ nub $ map (snd . fst) items
bin/yhc/src/tester/Report.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toList (fromList xs))
bin/yhc/src/packages/yhc-base-1.0/Data/Set.hs
import List(nub,sort)    
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
bin/yhc/src/packages/yhc-base-1.0/Data/Map.hs
import List(nub,groupBy,intersperse,sortBy)
bin/yhc/src/compiler98/ReportImports.hs
import Data.List((\\), partition, nubBy, sort)
bin/djinn/_darcs/pristine/Djinn/MJ.hs
import Data.List(sortBy, nub, intersperse)
bin/djinn/_darcs/pristine/Djinn/Djinn.hs
import Data.List((\\), partition, nubBy, sort)
bin/djinn/Djinn/MJ.hs
import Data.List(sortBy, nub, intersperse)
bin/djinn/Djinn/Djinn.hs
s ==? xs = invariant s && sort (toList s) == nub (sort xs)
bin/quickcheck/examples/ExSet2.hs
s ==? xs = invariant s && sort (toList s) == nub (sort xs)
bin/quickcheck/examples/ExTrie.hs
s ==? xs = invariant s && sort (toList s) == nub (sort xs)
bin/quickcheck/examples/ExSet.hs
s ==? xs = invariant s && sort (toList s) == nub (sort xs)
bin/quickcheck/_darcs/pristine/examples/ExSet2.hs
s ==? xs = invariant s && sort (toList s) == nub (sort xs)
bin/quickcheck/_darcs/pristine/examples/ExTrie.hs
s ==? xs = invariant s && sort (toList s) == nub (sort xs)
bin/quickcheck/_darcs/pristine/examples/ExSet.hs
import Sort ( msort, nub' )
bin/alex/src/DFA.hs
`nub'' is an n.log(n) version of `nub' and `group_sort' sorts a list into
nub' (<=) l = group_sort (<=) const l
bin/alex/src/Sort.hs
import Sort ( msort, nub' )
bin/alex/_darcs/pristine/src/DFA.hs
`nub'' is an n.log(n) version of `nub' and `group_sort' sorts a list into
nub' (<=) l = group_sort (<=) const l
bin/alex/_darcs/pristine/src/Sort.hs
    snub, snubFst, sortFst, groupFst,
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
bin/pencilpond/GenUtil.hs
    snub, snubFst, sortFst, groupFst,
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
bin/pencilpond/_darcs/pristine/GenUtil.hs
import Data.List (nub,sortBy)
bin/cabal-install/parsec-2.1.0.1/Text/ParserCombinators/Parsec/Error.hs
import Data.List (nub,sort)
bin/cabal-install/parsec-2.1.0.1/Text/ParserCombinators/Parsec/Token.hs
         ( unfoldr, find, nub, sort )
                         (nub . sort . depends $ pkg)
                         (nub . sort . depends $ pkg')
bin/cabal-install/Distribution/Client/Install.hs
import Data.List (groupBy, sortBy, nub, find, isInfixOf)
bin/cabal-install/Distribution/Client/PackageIndex.hs
         ( sortBy, groupBy, sort, nub, intersperse, maximumBy )
                            else nub . sort $ installedVersions pkg
bin/cabal-install/Distribution/Client/List.hs
         ( foldl', maximumBy, minimumBy, nub, sort, groupBy )
bin/cabal-install/Distribution/Client/Dependency/TopDown.hs
         ( unfoldr, find, nub, sort )
                         (nub . sort . depends $ pkg)
                         (nub . sort . depends $ pkg')
bin/cabal-install/_darcs/pristine/Distribution/Client/Install.hs
import Data.List (groupBy, sortBy, nub, find, isInfixOf)
bin/cabal-install/_darcs/pristine/Distribution/Client/PackageIndex.hs
         ( sortBy, groupBy, sort, nub, intersperse, maximumBy )
                            else nub . sort $ installedVersions pkg
bin/cabal-install/_darcs/pristine/Distribution/Client/List.hs
         ( foldl', maximumBy, minimumBy, nub, sort, groupBy )
bin/cabal-install/_darcs/pristine/Distribution/Client/Dependency/TopDown.hs
         , groupBy, sortBy, find, isInfixOf, nubBy, deleteBy, deleteFirstsBy )
bin/cabal-install/Cabal-1.8.0.2/Distribution/Simple/PackageIndex.hs
import Data.List                ( nub, sort, isSuffixOf )
    let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs))
bin/cabal-install/Cabal-1.8.0.2/Distribution/Simple/Hugs.hs
import Data.List  (sort, group, isPrefixOf, nub, find)
bin/cabal-install/Cabal-1.8.0.2/Distribution/PackageDescription/Check.hs
--   you supply for @x@ and @xs@ as they will be sorted and nubed anyway.  We
mkGConst x xs  = GeniVal Nothing (Just . sort . nub $ x:xs)
mkGVar x mxs  = GeniVal (Just x) ((sort . nub) `fmap` mxs)
bin/geni/src/NLP/GenI/GeniVal.hs
--   you supply for @x@ and @xs@ as they will be sorted and nubed anyway.  We
mkGConst x xs  = GeniVal Nothing (Just . sort . nub $ x:xs)
mkGVar x mxs  = GeniVal (Just x) ((sort . nub) `fmap` mxs)
bin/geni/_darcs/pristine/src/NLP/GenI/GeniVal.hs
import Data.List (intersperse, sort, sortBy, nub)
                                        , nub $ takeWhile (<= BC.length str) $ dropWhile (<0) $ map fromIntegral $ sort gs)
bin/bio/Bio/Alignment/Test.hs
import Data.List (nub,sort)
    where listElements = nub . sort . concatMap (\(_,x,y)->[x,y])
          clusterElements = nub . sort . concatMap cE
bin/bio/Bio/Clustering/Test.hs
import Data.List (intersperse, sort, sortBy, nub)
                                        , nub $ takeWhile (<= BC.length str) $ dropWhile (<0) $ map fromIntegral $ sort gs)
bin/bio/_darcs/pristine/Bio/Alignment/Test.hs
import Data.List (nub,sort)
    where listElements = nub . sort . concatMap (\(_,x,y)->[x,y])
          clusterElements = nub . sort . concatMap cE
bin/bio/_darcs/pristine/Bio/Clustering/Test.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
bin/archive/buddha-1.2.1/libbuddha/IntMap.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toAscList (fromList xs))
bin/archive/buddha-1.2.1/libbuddha/IntSet.hs
import qualified Data.List as List (sort, nub)
  , tcFreeVariables    = List.sort $ List.nub vs
bin/agda2/src/full/Agda/TypeChecking/Test/Generators.hs
    efficientNub xs =*= List.sort (List.nub xs)
bin/agda2/src/prototyping/mixfix/Utilities.hs
    efficientNub xs =*= List.sort (List.nub xs)
bin/agda2/src/prototyping/mixfix/benchmarks/PrecedenceGraph.hs
	xs' = List.sort $ List.nubBy ((==) `on` fst) xs
bin/agda2/src/prototyping/eval/Data/Trie.hs
import qualified Data.List as List (sort, nub)
  , tcFreeVariables    = List.sort $ List.nub vs
bin/agda2/_darcs/pristine/src/full/Agda/TypeChecking/Test/Generators.hs
    efficientNub xs =*= List.sort (List.nub xs)
bin/agda2/_darcs/pristine/src/prototyping/mixfix/Utilities.hs
    efficientNub xs =*= List.sort (List.nub xs)
bin/agda2/_darcs/pristine/src/prototyping/mixfix/benchmarks/PrecedenceGraph.hs
	xs' = List.sort $ List.nubBy ((==) `on` fst) xs
bin/agda2/_darcs/pristine/src/prototyping/eval/Data/Trie.hs
import qualified Data.List as List (sort, nub)
  , tcFreeVariables    = List.sort $ List.nub vs
bin/agda2/_darcs/pristine-old/src/full/Agda/TypeChecking/Test/Generators.hs
    efficientNub xs =*= List.sort (List.nub xs)
bin/agda2/_darcs/pristine-old/src/prototyping/mixfix/Utilities.hs
    efficientNub xs =*= List.sort (List.nub xs)
bin/agda2/_darcs/pristine-old/src/prototyping/mixfix/benchmarks/PrecedenceGraph.hs
	xs' = List.sort $ List.nubBy ((==) `on` fst) xs
bin/agda2/_darcs/pristine-old/src/prototyping/eval/Data/Trie.hs
import Data.List (foldl', intersperse, sortBy, groupBy, nub)
bin/xmc-bluetile/XMonad/Util/EZConfig.hs
import Data.List ( nub, sortBy, (\\) )
bin/xmc-bluetile/XMonad/Layout/WindowNavigation.hs
import Data.List ( sort, nub )
                    mkXPrompt (Wor "") c (mkCompl $ sort $ nub ls) (sendMessage . JumpToLayout)
bin/xmc-bluetile/XMonad/Prompt/Layout.hs
      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
bin/xmc-bluetile/XMonad/Actions/TopicSpace.hs
import Data.List (nub,concat,sortBy)
bin/xmc-bluetile/XMonad/Actions/TagWindows.hs
import Data.List (foldl', sortBy, groupBy, nub)
bin/xmc/XMonad/Util/EZConfig.hs
import Data.List ( nub, sortBy, (\\) )
bin/xmc/XMonad/Layout/WindowNavigation.hs
import Data.List ( sort, nub )
                    mkXPrompt (Wor "") c (mkComplFunFromList' $ sort $ nub ls) (sendMessage . JumpToLayout)
bin/xmc/XMonad/Prompt/Layout.hs
      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
bin/xmc/XMonad/Actions/TopicSpace.hs
import Data.List (nub,sortBy)
bin/xmc/XMonad/Actions/TagWindows.hs
import Data.List (foldl', sortBy, groupBy, nub)
bin/xmc/_darcs/pristine/XMonad/Util/EZConfig.hs
import Data.List ( nub, sortBy, (\\) )
bin/xmc/_darcs/pristine/XMonad/Layout/WindowNavigation.hs
import Data.List ( sort, nub )
                    mkXPrompt (Wor "") c (mkComplFunFromList' $ sort $ nub ls) (sendMessage . JumpToLayout)
bin/xmc/_darcs/pristine/XMonad/Prompt/Layout.hs
      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
bin/xmc/_darcs/pristine/XMonad/Actions/TopicSpace.hs
import Data.List (nub,sortBy)
bin/xmc/_darcs/pristine/XMonad/Actions/TagWindows.hs
	-> all 	(== (nub $ sort xx)) 
		[ nub $ sort (y:ys) | (y, ys) <- eachAndOthers xx]
bin/ddc/src/Util/Data/List/Select.hs
	-> all 	(== (nub $ sort xx)) 
		[ nub $ sort (y:ys) | (y, ys) <- eachAndOthers xx]
bin/ddc/_darcs/pristine/src/Util/Data/List/Select.hs
import Data.List (sortBy, nub, sort, elemIndex)
        ((eitherOrEditor (comboSelectionEditor ((sort . nub) (map (display . pkgName) packages)) id
bin/leksah/src/Graphics/UI/Editor/Composite.hs
import Data.List (sort,nub,nubBy)
            (staticListEditor ((nub . sort) list) id)
bin/leksah/src/IDE/ImportTool.hs
import Data.List (foldl',nub,delete,sort)
bin/leksah/src/IDE/Metainfo/SourceCollector.hs
        assertEqual (length . nub . sort $ map keyB bs) (length bs)
        assertEqual 1 (length . nub . sort $ bs')
bin/yi/attic/testsuite/Tests/Buffer.hs
import Data.List (partition, sort, nub)
fromVtyEvent (EvKey Vty.KBackTab mods) = Event Yi.Event.KTab (sort $ nub $ Yi.Event.MShift : map fromVtyMod mods)
bin/yi/src/Yi/UI/Vty.hs
import Data.List (span, length, sort, nub, break, reverse, filter, takeWhile, dropWhile)
       indentToB $ chooseIndent currentIndent (sort $ nub $ indents)
bin/yi/src/Yi/Buffer/Indent.hs
import Data.List (sort, nub)
shift (Event k ms) = Event k $ nub $ sort (MShift:ms)
ctrl (Event k ms) = Event k $ nub $ sort (MCtrl:ms)
meta (Event k ms) = Event k $ nub $ sort (MMeta:ms)
super (Event k ms) = Event k $ nub $ sort (MSuper:ms)
bin/yi/src/Yi/Keymap/Keys.hs
import Data.List ( isPrefixOf, find, nubBy, sort, (\\) )
bin/yi/src/Shim/Hsinfo.hs
import Data.List (nub,sortBy)
bin/hat/src/lib/Text/ParserCombinators/Parsec/Error.hs
import Data.List (nub,sort)
bin/hat/src/lib/Text/ParserCombinators/Parsec/Token.hs
import List(nub,groupBy,intersperse,sortBy)
bin/hat/src/compiler98/ReportImports.hs
import Data.List (nub,sortBy)
bin/hat/_darcs/pristine/src/lib/Text/ParserCombinators/Parsec/Error.hs
import Data.List (nub,sort)
bin/hat/_darcs/pristine/src/lib/Text/ParserCombinators/Parsec/Token.hs
import List(nub,groupBy,intersperse,sortBy)
bin/hat/_darcs/pristine/src/compiler98/ReportImports.hs
    snub, snubFst, sortFst, groupFst, foldl',
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
bin/riot-1ds-20080618/Ginsu/GenUtil.hs
prop_span3 dist ps = length ps > 1 ==> sort (nub ps) == sort (nub qs)
bin/wired/_darcs/pristine/Data/Hardware/Internal.hs
prop_span3 dist ps = length ps > 1 ==> sort (nub ps) == sort (nub qs)
bin/wired/Data/Hardware/Internal.hs
import Data.List -- (nub, sort)
bin/haskell/hcorpus/hcorpus.hs
import Data.List -- (nub, sort)
          let knownwords = nub $ sort ["You", "dont", "see", "more", "than", "that", "The", "first", "episode", "of", "Kare", "Kano", "is", "rotten", "with", "Evangelion", "visual", "motifs", "the", "trains", "the", "spotlights", "and", "telephone", "poles", "and", "wires", "the", "masks", "and", "this", "is", "how", "everyone", "sees", "me", "etc", "And", "later", "there", "are", "some", "even", "more", "obvious", "borrowings"]
uniquefy = nub . sort . concat
-- be much more efficient than doing something like 'nub $ sort $ map take n $ Data.List.permutations xs'.
bin/haskell/hcorpus/hcorpus-slow.hs
sort = nub . List.sort
bin/edison/test/src/Data/Edison/Test/Set.hs
       b = L.sort (L.nub (keysList xs ++ keysList ys))
bin/edison/test/src/Data/Edison/Test/FM.hs
sort = nub . List.sort
bin/edison/_darcs/pristine/test/src/Data/Edison/Test/Set.hs
       b = L.sort (L.nub (keysList xs ++ keysList ys))
bin/edison/_darcs/pristine/test/src/Data/Edison/Test/FM.hs
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" ["after","append","AppleScript","argv","argc","array","auto_execk","auto_load","auto_mkindex","auto_path","auto_reset","beep","bell","binary","bind","bindtags","bgerror","break","button","canvas","case","catch","cd","checkbutton","clipboard","clock","close","concat","console","continue","dde","destroy","else","elseif","encoding","entry","env","eof","error","errorCode","errorInfo","eval","event","exec","exit","expr","fblocked","fconfigure","fcopy","file","fileevent","flush","focus","font","for","foreach","format","frame","gets","glob","global","grab","grid","history","if","image","incr","info","interp","join","label","lappend","lindex","linsert","list","listbox","llength","load","lower","lrange","lreplace","lsearch","lsort","menu","menubutton","message","namespace","open","option","OptProc","pack","package","parray","pid","place","pkg_mkindex","proc","puts","pwd","radiobutton","raise","read","regexp","registry","regsub","rename","resource","return","scale","scan","scrollbar","seek","selection","send","set","socket","source","split","string","subst","switch","tclLog","tcl_endOfWord","tcl_findLibrary","tcl_library","tcl_patchLevel","tcl_platform","tcl_precision","tcl_rcFileName","tcl_rcRsrcName","tcl_startOfNextWord","tcl_startOfPreviousWord","tcl_traceCompile","tcl_traceExec","tcl_version","tcl_wordBreakAfter","tcl_wordBreakBefore","tell","text","time","tk","tkTabToWindow","tkwait","tk_chooseColor","tk_chooseDirectory","tk_focusFollowMouse","tk_focusNext","tk_focusPrev","tk_getOpenFile","tk_getSaveFile","tk_library","tk_messageBox","tk_optionMenu","tk_patchLevel","tk_popup","tk_strictMotif","tk_version","toplevel","trace","unknown","unset","update","uplevel","upvar","variable","vwait","while","winfo","wm"] >>= withAttribute "Keyword"))
bin/highlighting-kate/Text/Highlighting/Kate/Syntax/Tcl.hs
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" ["above","action","alinkColor","alert","anchor","anchors","appCodeName","applets","apply","appName","appVersion","argument","arguments","arity","availHeight","availWidth","back","background","below","bgColor","border","big","blink","blur","bold","border","call","caller","charAt","charCodeAt","checked","clearInterval","clearTimeout","click","clip","close","closed","colorDepth","complete","compile","constructor","confirm","cookie","current","cursor","data","defaultChecked","defaultSelected","defaultStatus","defaultValue","description","disableExternalCapture","domain","elements","embeds","enabledPlugin","enableExternalCapture","encoding","eval","exec","fgColor","filename","find","fixed","focus","fontcolor","fontsize","form","forms","formName","forward","frames","fromCharCode","getDate","getDay","getHours","getMiliseconds","getMinutes","getMonth","getSeconds","getSelection","getTime","getTimezoneOffset","getUTCDate","getUTCDay","getUTCFullYear","getUTCHours","getUTCMilliseconds","getUTCMinutes","getUTCMonth","getUTCSeconds","getYear","global","go","hash","height","history","home","host","hostname","href","hspace","ignoreCase","images","index","indexOf","innerHeight","innerWidth","input","italics","javaEnabled","join","language","lastIndex","lastIndexOf","lastModified","lastParen","layers","layerX","layerY","left","leftContext","length","link","linkColor","links","location","locationbar","load","lowsrc","match","MAX_VALUE","menubar","method","mimeTypes","MIN_VALUE","modifiers","moveAbove","moveBelow","moveBy","moveTo","moveToAbsolute","multiline","name","NaN","NEGATIVE_INFINITY","negative_infinity","next","open","opener","options","outerHeight","outerWidth","pageX","pageY","pageXoffset","pageYoffset","parent","parse","pathname","personalbar","pixelDepth","platform","plugins","pop","port","POSITIVE_INFINITY","positive_infinity","preference","previous","print","prompt","protocol","prototype","push","referrer","refresh","releaseEvents","reload","replace","reset","resizeBy","resizeTo","reverse","rightContext","screenX","screenY","scroll","scrollbar","scrollBy","scrollTo","search","select","selected","selectedIndex","self","setDate","setHours","setMinutes","setMonth","setSeconds","setTime","setTimeout","setUTCDate","setUTCDay","setUTCFullYear","setUTCHours","setUTCMilliseconds","setUTCMinutes","setUTCMonth","setUTCSeconds","setYear","shift","siblingAbove","siblingBelow","small","sort","source","splice","split","src","status","statusbar","strike","sub","submit","substr","substring","suffixes","sup","taintEnabled","target","test","text","title","toGMTString","toLocaleString","toLowerCase","toolbar","toSource","toString","top","toUpperCase","toUTCString","type","URL","unshift","unwatch","userAgent","UTC","value","valueOf","visibility","vlinkColor","vspace","width","watch","which","width","write","writeln","x","y","zIndex"] >>= withAttribute "Data Type"))
bin/highlighting-kate/Text/Highlighting/Kate/Syntax/Javascript.hs
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" ["after","append","AppleScript","argv","argc","array","auto_execk","auto_load","auto_mkindex","auto_path","auto_reset","beep","bell","binary","bind","bindtags","bgerror","break","button","canvas","case","catch","cd","checkbutton","clipboard","clock","close","concat","console","continue","dde","destroy","else","elseif","encoding","entry","env","eof","error","errorCode","errorInfo","eval","event","exec","exit","expr","fblocked","fconfigure","fcopy","file","fileevent","flush","focus","font","for","foreach","format","frame","gets","glob","global","grab","grid","history","if","image","incr","info","interp","join","label","lappend","lindex","linsert","list","listbox","llength","load","lower","lrange","lreplace","lsearch","lsort","menu","menubutton","message","namespace","open","option","OptProc","pack","package","parray","pid","place","pkg_mkindex","proc","puts","pwd","radiobutton","raise","read","regexp","registry","regsub","rename","resource","return","scale","scan","scrollbar","seek","selection","send","set","socket","source","split","string","subst","switch","tclLog","tcl_endOfWord","tcl_findLibrary","tcl_library","tcl_patchLevel","tcl_platform","tcl_precision","tcl_rcFileName","tcl_rcRsrcName","tcl_startOfNextWord","tcl_startOfPreviousWord","tcl_traceCompile","tcl_traceExec","tcl_version","tcl_wordBreakAfter","tcl_wordBreakBefore","tell","text","time","tk","tkTabToWindow","tkwait","tk_chooseColor","tk_chooseDirectory","tk_focusFollowMouse","tk_focusNext","tk_focusPrev","tk_getOpenFile","tk_getSaveFile","tk_library","tk_messageBox","tk_optionMenu","tk_patchLevel","tk_popup","tk_strictMotif","tk_version","toplevel","trace","unknown","unset","update","uplevel","upvar","variable","vwait","while","winfo","wm"] >>= withAttribute "Keyword"))
bin/highlighting-kate/_darcs/pristine/Text/Highlighting/Kate/Syntax/Tcl.hs
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" ["above","action","alinkColor","alert","anchor","anchors","appCodeName","applets","apply","appName","appVersion","argument","arguments","arity","availHeight","availWidth","back","background","below","bgColor","border","big","blink","blur","bold","border","call","caller","charAt","charCodeAt","checked","clearInterval","clearTimeout","click","clip","close","closed","colorDepth","complete","compile","constructor","confirm","cookie","current","cursor","data","defaultChecked","defaultSelected","defaultStatus","defaultValue","description","disableExternalCapture","domain","elements","embeds","enabledPlugin","enableExternalCapture","encoding","eval","exec","fgColor","filename","find","fixed","focus","fontcolor","fontsize","form","forms","formName","forward","frames","fromCharCode","getDate","getDay","getHours","getMiliseconds","getMinutes","getMonth","getSeconds","getSelection","getTime","getTimezoneOffset","getUTCDate","getUTCDay","getUTCFullYear","getUTCHours","getUTCMilliseconds","getUTCMinutes","getUTCMonth","getUTCSeconds","getYear","global","go","hash","height","history","home","host","hostname","href","hspace","ignoreCase","images","index","indexOf","innerHeight","innerWidth","input","italics","javaEnabled","join","language","lastIndex","lastIndexOf","lastModified","lastParen","layers","layerX","layerY","left","leftContext","length","link","linkColor","links","location","locationbar","load","lowsrc","match","MAX_VALUE","menubar","method","mimeTypes","MIN_VALUE","modifiers","moveAbove","moveBelow","moveBy","moveTo","moveToAbsolute","multiline","name","NaN","NEGATIVE_INFINITY","negative_infinity","next","open","opener","options","outerHeight","outerWidth","pageX","pageY","pageXoffset","pageYoffset","parent","parse","pathname","personalbar","pixelDepth","platform","plugins","pop","port","POSITIVE_INFINITY","positive_infinity","preference","previous","print","prompt","protocol","prototype","push","referrer","refresh","releaseEvents","reload","replace","reset","resizeBy","resizeTo","reverse","rightContext","screenX","screenY","scroll","scrollbar","scrollBy","scrollTo","search","select","selected","selectedIndex","self","setDate","setHours","setMinutes","setMonth","setSeconds","setTime","setTimeout","setUTCDate","setUTCDay","setUTCFullYear","setUTCHours","setUTCMilliseconds","setUTCMinutes","setUTCMonth","setUTCSeconds","setYear","shift","siblingAbove","siblingBelow","small","sort","source","splice","split","src","status","statusbar","strike","sub","submit","substr","substring","suffixes","sup","taintEnabled","target","test","text","title","toGMTString","toLocaleString","toLowerCase","toolbar","toSource","toString","top","toUpperCase","toUTCString","type","URL","unshift","unwatch","userAgent","UTC","value","valueOf","visibility","vlinkColor","vspace","width","watch","which","width","write","writeln","x","y","zIndex"] >>= withAttribute "Data Type"))
bin/highlighting-kate/_darcs/pristine/Text/Highlighting/Kate/Syntax/Javascript.hs
import List(sort,nub)
    let prop_list x xs = sort (List.delete x $ nub xs) == toList p where
bin/jhc/src/selftest/SelfTest.hs
    snub, snubFst, snubUnder, smerge, sortFst, groupFst, foldl',
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
-- | sorted nub of list based on function of values
snubUnder f = map head . groupUnder f . sortUnder f
bin/jhc/src/GenUtil.hs
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
bin/jhc/src/Util/IntBag.hs
    | all (== r) rs = ARules (fvsa `mappend` fvsb) (sortUnder (\r -> (ruleNArgs r,ruleUniq r)) (snubUnder ruleUniq $ a ++ b))
bin/jhc/src/E/Rules.hs
collectUsedFuncs (as :-> exp) = (snub $ concatMap tagToFunction (Seq.toList iu),sort $ Seq.toList du) where
bin/jhc/src/Grin/Simplify.hs
import Data.List (intersperse, sortBy, groupBy, nub, maximumBy)
bin/hackage-server/Distribution/Server/Pages/Index.hs
import Data.List (intersperse, sortBy, groupBy, nub, maximumBy)
bin/hackage-server/_darcs/pristine/Distribution/Server/Pages/Index.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toList (fromList xs))
bin/ehc/src/lvm/Common/Set.hs
import List       (sortBy, sort, partition, union, nub)
bin/ehc/src/helium/StaticAnalysis/Messages/Messages.hs
-- group/sort/nub combi's
bin/ehc/src/libutil/EH/Util/Utils.hs
  . nub . sort . concat
     in sortBy (cmpByVersionOrder vo) . nub . sort $ all
  = let allN = nub . sort . concat $ vo
          = map (\p@((v,_):_) -> (ixOf v,map ixOf . nub . sort . (v:) . concat . map snd $ p))
     in sortBy (cmpByVersionOrder vo) . nub . sort $ allN'
        availVersions   = nub . sort . map vciVer $ nonPre
bin/ehc/build/shuffle/MainAG.hs
raltLPatNms = nub . sort . map (rcpPNm . rcaPat)
bin/ehc/build/101/lib-ehc/EH101/Core.hs
import Data.List( (\\), sort, intercalate, nub, intersperse )
bin/hashed-storage/Storage/Hashed/Test.hs
        con = sort $ nub [(c,v) | TApp (TLit c) xs <- a, x <- xs, v <- variables x, v `elem` vs]
bin/hoogle/src/Hoogle/DataBase/Instances.hs
normAliases as t = first (sort . nub) $ f t
bin/hoogle/src/Hoogle/DataBase/Aliases.hs
        con = sort $ nub [(c,v) | TApp (TLit c) xs <- a, x <- xs, v <- variables x, v `elem` vs]
bin/hoogle/_darcs/pristine/src/Hoogle/DataBase/Instances.hs
normAliases as t = first (sort . nub) $ f t
bin/hoogle/_darcs/pristine/src/Hoogle/DataBase/Aliases.hs
import Data.List            (nub,sort,sortBy,group,sort,intersperse,genericLength)
bin/xmonad/tests/Properties.hs
import Data.List            (nub,sort,sortBy,group,sort,intersperse,genericLength)
bin/xmonad/_darcs/pristine/tests/Properties.hs
   Key.nub fst (Key.sort fst (allIntEquations (permute [1,5,6,7])))
bin/htam/src/Riddle/Equation.hs
import Data.List (genericIndex, sort, nub, )
   Key.nub fst . sort
      nub . sort
      nub . sort
bin/htam/src/Test/Combinatorics.hs
   Key.nub fst (Key.sort fst (allIntEquations (permute [1,5,6,7])))
bin/htam/_darcs/pristine/src/Riddle/Equation.hs
import Data.List (genericIndex, sort, nub, )
   Key.nub fst . sort
      nub . sort
      nub . sort
bin/htam/_darcs/pristine/src/Test/Combinatorics.hs
    snub, snubFst, sortFst, groupFst, foldl',
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
bin/drift/src/GenUtil.hs
import List (nub,sortBy)
bin/drift/src/Rules/Xml.hs
    snub, snubFst, sortFst, groupFst, foldl',
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
bin/drift/_darcs/pristine/src/GenUtil.hs
import List (nub,sortBy)
bin/drift/_darcs/pristine/src/Rules/Xml.hs
    snub, snubFst, sortFst, groupFst, foldl',
-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub = map head . group . sort
-- | sorted nub of list of tuples, based solely on the first element of each tuple.
snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)
bin/drift/_darcs/pristine-old/src/GenUtil.hs
import List (nub,sortBy)
bin/drift/_darcs/pristine-old/src/Rules/Xml.hs
module Darcs.Utils ( catchall, ortryrunning, nubsort, breakCommand,
nubsort :: Ord a => [a] -> [a]
nubsort = map head . group . sort
bin/darcs/src/Darcs/Utils.hs
import Darcs.Utils ( nubsort )
        nubsort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p
        nubsort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p
bin/darcs/src/Darcs/Patch/Real.hs
import Darcs.Utils ( promptYorn, catchall, withCurrentDirectory, withUMask, nubsort )
    case nubsort $ listTouchedFiles $ resolved_pw of
bin/darcs/src/Darcs/Repository/Internal.hs
  nubsort [e1 | e <- exps, Right e1 <- [checkExpr pgf e ty]]
bin/gf/src/runtime/haskell/PGF/Parse.hs
import Data.List (nub,sort,group)
bin/gf/src/runtime/haskell/PGF/Paraphrase.hs
import Data.List (intersperse,nub,isPrefixOf,sort,sortBy)
bin/gf/src/runtime/haskell/PGF/VisualizeTree.hs
import Data.List (sortBy,nub)
bin/gf/src/compiler/GF/Grammar/Macros.hs
import Data.List (nub,sortBy)
bin/gf/src/compiler/GF/Grammar/Lookup.hs
    if null end then return (nub (sort ws)) else do
bin/gf/src/compiler/GF/Compile/ExampleBased.hs
      nubsort, union, 
nubsort :: Ord a => [a] -> SList a
nubsort = union . map return
bin/gf/src/compiler/GF/Data/SortedList.hs
import Data.List (nub, sortBy, sort, deleteBy, nubBy)
bin/gf/src/compiler/GF/Data/Operations.hs
-- | Like 'nub', but more efficient as it uses sorting internally.
-- | Like 'nubBy', but more efficient as it uses sorting internally.
bin/gf/src/compiler/GF/Data/Utilities.hs
      anames = sort $ nub $ map paccount ps
bin/hledger/Ledger/Journal.hs
      anames = sort $ nub $ map paccount ps
bin/hledger/Commands/Register.hs
import Data.List (sort, sortBy, nub)
  let allVersionsUsed = nub (sort (versionsUsed vr1 ++ versionsUsed vr2))
bin/cabal/tests/Test/Distribution/Version.hs
         , groupBy, sortBy, find, isInfixOf, nubBy, deleteBy, deleteFirstsBy )
bin/cabal/Distribution/Simple/PackageIndex.hs
import Data.List                ( nub, sort, isSuffixOf )
    let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs))
bin/cabal/Distribution/Simple/Hugs.hs
import Data.List  (sort, group, isPrefixOf, nub, find)
bin/cabal/Distribution/PackageDescription/Check.hs
import Data.List (sort, sortBy, nub)
  let allVersionsUsed = nub (sort (versionsUsed vr1 ++ versionsUsed vr2))
bin/cabal/_darcs/pristine/tests/Test/Distribution/Version.hs
         , groupBy, sortBy, find, isInfixOf, nubBy, deleteBy, deleteFirstsBy )
bin/cabal/_darcs/pristine/Distribution/Simple/PackageIndex.hs
import Data.List                ( nub, sort, isSuffixOf )
    let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs))
bin/cabal/_darcs/pristine/Distribution/Simple/Hugs.hs
import Data.List  (sort, group, isPrefixOf, nub, find)
bin/cabal/_darcs/pristine/Distribution/PackageDescription/Check.hs
stPath d v sts = sort $ nub $ (concat $ map (ndfadestinationsFrom d v) sts) ++ sts
bin/pure/software/haskell/libraries/Language/HaLex/Ndfa.hs
stPath d v sts = sort $ nub $ 
bin/pure/software/haskell/libraries/Language/HaLex/Dfa.hs
import List (nub, intersperse, partition, sort,sort,group)
precLevels cf = sort $ nub $ [ precCat c | c <- allCats cf]
bin/bnfc/CF.hs
import List (nub, intersperse, partition, sort,sort,group)
precLevels cf = sort $ nub $ [ precCat c | c <- allCats cf]
bin/bnfc/_darcs/pristine/CF.hs
import List (nub, intersperse, partition, sort,sort,group)
precLevels cf = sort $ nub $ [ precCat c | c <- allCats cf]
bin/bnfc/_darcs/pristine-old/CF.hs
import Data.List (intersperse,sortBy,partition,nub)
bin/xml2x/src/Xml2X.hs
import Data.List (intersperse,sortBy,partition,nub)
bin/xml2x/_darcs/pristine/src/Xml2X.hs
import List (elemIndex, sort, nub)
          valid xs = is 'a' $ nub $ sort xs
bin/lcs/_darcs/pristine/testsuite/Test.hs
import List (elemIndex, sort, nub)
          valid xs = is 'a' $ nub $ sort xs
bin/lcs/testsuite/Test.hs
import Data.List            (sort,nub,group,intersperse)
bin/xmonad-fork/tests/StackProperties.hs
import Data.List            (sort,nub,group,intersperse)
bin/xmonad-fork/tests/NestedStackProperties.hs
import Data.List            (nub,sort,sortBy,group,sort,intersperse,genericLength)
bin/xmonad-fork/tests/Properties.hs
import Data.List ( nub, sortBy, (\\) )
bin/xmonad-fork/XMonad/Layout/WindowNavigation.hs
import Data.List (nub, sortBy, partition)
bin/hackage-scripts/SearchAlgorithm.hs
import Data.List (nub, sortBy, partition)
bin/hackage-scripts/_darcs/pristine/SearchAlgorithm.hs
  periods = sort $ nub $ map sysPeriod systems
bin/atom/Atom/Scheduling.hs
  periods = sort $ nub $ map sysPeriod systems
bin/atom/_darcs/pristine/Atom/Scheduling.hs
import Data.List (intersect, nub, sort, isPrefixOf, isInfixOf)
bin/filestore-pt/Data/FileStore/Darcs.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toList (fromList xs))
bin/heliumsystem/lvm/src/lib/common/Set.hs
import List      (nub,sortBy)
bin/heliumsystem/lvm/src/lib/parsec/ParsecError.hs
import List        (nub, intersperse, sort, partition)
bin/heliumsystem/helium/src/staticanalysis/messages/StaticErrors.hs
import Data.List            (nub,sort,sortBy,group,sort,intersperse,genericLength)
bin/xmonad-monoid/tests/Properties.hs
import Data.List            (nub,sort,sortBy,group,sort,intersperse,genericLength)
bin/xmonad-monoid/_darcs/pristine/tests/Properties.hs
                 , sortBy, mapAccumL, nub )
bin/citeproc-hs/src/Text/CSL/Proc.hs
import Data.List(transpose,nub,maximumBy,genericLength,elemIndex, genericTake, sort)
bin/easyvision/cabal/vision/lib/Vision/Camera.hs
import Data.List(sortBy, sort, nub, elemIndex, intersperse, transpose, partition, delete)
bin/easyvision/cabal/patrec/lib/Classifier/Simple.hs
import Data.List(sortBy, sort, nub, elemIndex, intersperse, transpose, partition, delete)
    ls = sort $ nub $ map snd l
bin/easyvision/cabal/patrec/lib/Classifier/Base.hs
import Data.List(sort,nub,sortBy,minimumBy)
    print (sort $ nub $ map snd okclasses)
bin/easyvision/cabal/ev/lib/EasyVision/MiniApps.hs
import Data.List(sort,nub,sortBy,minimumBy)
bin/easyvision/cabal/ev/lib/EasyVision/MiniApps/PoseTracker.hs
import Data.List(transpose,nub,maximumBy,genericLength,elemIndex, genericTake, sort)
bin/easyvision/_darcs/pristine/cabal/vision/lib/Vision/Camera.hs
import Data.List(sortBy, sort, nub, elemIndex, intersperse, transpose, partition, delete)
bin/easyvision/_darcs/pristine/cabal/patrec/lib/Classifier/Simple.hs
import Data.List(sortBy, sort, nub, elemIndex, intersperse, transpose, partition, delete)
    ls = sort $ nub $ map snd l
bin/easyvision/_darcs/pristine/cabal/patrec/lib/Classifier/Base.hs
import Data.List(sort,nub,sortBy,minimumBy)
    print (sort $ nub $ map snd okclasses)
bin/easyvision/_darcs/pristine/cabal/ev/lib/EasyVision/MiniApps.hs
import Data.List(sort,nub,sortBy,minimumBy)
bin/easyvision/_darcs/pristine/cabal/ev/lib/EasyVision/MiniApps/PoseTracker.hs
                 lines, nub, partition, sortBy, unlines, words, break, lookup, tail,
bin/seereason/autobuilder/Debian/AutoBuilder/Target.hs
                 lines, nub, partition, sortBy, unlines, words, break, lookup, tail,
bin/seereason/autobuilder/_darcs/pristine/Debian/AutoBuilder/Target.hs
import Data.List (intercalate, nub, sort)
                       		  intercalate "\n  " (nub (sort (map (format . sourcePackageID) deps)))))
bin/seereason/haskell-debian-3/_darcs/pristine/demos/DependsOn.hs
import Data.List (intercalate, nub, sort)
                       		  intercalate "\n  " (nub (sort (map (format . sourcePackageID) deps)))))
bin/seereason/haskell-debian-3/demos/DependsOn.hs
      nubOn selector list = map head $ groupBy ((==) `on` selector) $ sortBy (compare `on` selector) list
bin/seereason/backups/System/Archive/AptMethods.hs
      nubOn selector list = map head $ groupBy ((==) `on` selector) $ sortBy (compare `on` selector) list
bin/seereason/backups/_darcs/pristine/System/Archive/AptMethods.hs
      nub' = map head . group . sort
bin/seereason/mirror/Debian/Mirror/Dist.hs
      nub' = map head . group . sort
bin/seereason/mirror/_darcs/pristine/Debian/Mirror/Dist.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
bin/ghc/libraries/containers/Data/IntMap.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toList (fromList xs))
bin/ghc/libraries/containers/Data/Set.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toAscList (fromList xs))
bin/ghc/libraries/containers/Data/IntSet.hs
import List(nub,sort)    
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
bin/ghc/libraries/containers/Data/Map.hs
import Data.List (sort, sortBy, nub)
  let allVersionsUsed = nub (sort (versionsUsed vr1 ++ versionsUsed vr2))
bin/ghc/libraries/Cabal/tests/Test/Distribution/Version.hs
         , groupBy, sortBy, find, isInfixOf, nubBy, deleteBy, deleteFirstsBy )
bin/ghc/libraries/Cabal/Distribution/Simple/PackageIndex.hs
import Data.List                ( nub, sort, isSuffixOf )
    let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs))
bin/ghc/libraries/Cabal/Distribution/Simple/Hugs.hs
import Data.List  (sort, group, isPrefixOf, nub, find)
bin/ghc/libraries/Cabal/Distribution/PackageDescription/Check.hs
        free = sort $ nub [x | x <- lexs, length x == 1, all isAlpha x]
bin/ghc/libraries/filepath/test/GenTests.hs
getLabels = sort . nub . filter is_interesting_label
bin/ghc/utils/debugNCG/Diff_Gcc_Nat.hs
             nubBy  ((==) `on` wayName) $ unsorted
bin/ghc/compiler/main/StaticFlags.hs
    ordered = sortAssocs . nubAssocs
bin/blas/tests/Vector.hs
    ordered = sortAssocs . nubAssocs
bin/blas/tests/Banded.hs
    ordered = sortAssocs . nubAssocs
bin/blas/tests/Matrix.hs
    ordered = sortAssocs . nubAssocs
bin/blas/_darcs/pristine/tests/Vector.hs
    ordered = sortAssocs . nubAssocs
bin/blas/_darcs/pristine/tests/Banded.hs
    ordered = sortAssocs . nubAssocs
bin/blas/_darcs/pristine/tests/Matrix.hs
dataDeclFields = sort . nub . filter (not . null) . map fst . concatMap ctorDeclFields . dataDeclCtors
bin/derive/Language/Haskell.hs
dataDeclFields = sort . nub . filter (not . null) . map fst . concatMap ctorDeclFields . dataDeclCtors
bin/derive/_darcs/pristine/Language/Haskell.hs
              sort, (\\), nub )
bin/shim/Shim/Hsinfo.hs
              sort, (\\), nub )
bin/shim/_darcs/pristine/Shim/Hsinfo.hs
import Data.List ( nub, transpose, sort )
bin/chart/Graphics/Rendering/Chart/Renderable.hs
        mxs = nub $ sort $ map mapX xs
bin/chart/Graphics/Rendering/Chart/Plot.hs
import Data.List(sort,nub)
bin/chart/tests/darcs_usage.hs
import Data.List(sort,nub,scanl1)
bin/chart/tests/test.hs
import Data.List ( nub, transpose, sort )
bin/chart/_darcs/pristine/Graphics/Rendering/Chart/Renderable.hs
        mxs = nub $ sort $ map mapX xs
bin/chart/_darcs/pristine/Graphics/Rendering/Chart/Plot.hs
import Data.List(sort,nub)
bin/chart/_darcs/pristine/tests/darcs_usage.hs
import Data.List(sort,nub,scanl1)
bin/chart/_darcs/pristine/tests/test.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
bin/lhc/lib/containers-0.2.0.1/Data/IntMap.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toList (fromList xs))
bin/lhc/lib/containers-0.2.0.1/Data/Set.hs
import List (nub,sort)
    == List.sort ((List.\\) (nub xs)  (nub ys))
    == List.sort (nub ((List.intersect) (xs)  (ys)))
  = (sort (nub xs) == toAscList (fromList xs))
bin/lhc/lib/containers-0.2.0.1/Data/IntSet.hs
import List(nub,sort)    
    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
  = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
bin/lhc/lib/containers-0.2.0.1/Data/Map.hs
import Data.List(nub, nubBy, (\\), find, sort, sortBy, group, groupBy)
bin/graphalyze/_darcs/pristine/Data/Graph/Analysis/Utils.hs
import Data.List(nub, nubBy, (\\), find, sort, sortBy, group, groupBy)
bin/graphalyze/Data/Graph/Analysis/Utils.hs
  let nub = map head . group . sort
bin/maak/hssrc/Export.hs
import Data.List (intersperse, nub, sortBy, find, isPrefixOf, inits, sort)
                liftM (nub . sort . concat) $
bin/gitit/Network/Gitit/Handlers.hs
import Data.List (intercalate, sortBy, nub)
  -- TODO: 'nub . sort' `persons` - but no Eq or Ord instances!
      persons = map authorToPerson $ nub $ sortBy (comparing authorName) $ map revAuthor revs
bin/gitit/Network/Gitit/Feed.hs
      nub . sort . concat <$> traverse exts mods
allModules xs = nub . sort . concat <$> (traverse (fmap unM . dep) =<< localModules xs)
      nub . sort . concat . (mods:) <$> traverse depLocalTrans mods
            nub . sort . concat . (ms:) <$> traverse depLocalTrans ms
bin/hbuild/Make/RulesIO.hs
import Data.List (nub, sort)
bin/hbuild/Make/Rules.hs
      nub . sort . concat <$> traverse exts mods
allModules = memoPure1 "allModules" $ nub . sort . concat <$> (traverse dep =<< localModules)
      nub . sort . concat . (mods:) <$> traverse depLocalTrans mods
            nub . sort . concat . (ms:) <$> traverse depLocalTrans ms
bin/hbuild/Make/Rules/Dyn.hs
        free = sort $ nub [x | x <- lexs, length x == 1, all isAlpha x]
bin/filepath/test/GenTests.hs
        free = sort $ nub [x | x <- lexs, length x == 1, all isAlpha x]
bin/filepath/_darcs/pristine/test/GenTests.hs
        f xs = filter (`Map.member` mp) $ sort $ nub $ xs ++ new
bin/tagsoup/TagSoup/Generate/Supercompile.hs
        f xs = filter (`Map.member` mp) $ sort $ nub $ xs ++ new
bin/tagsoup/_darcs/pristine/TagSoup/Generate/Supercompile.hs


More information about the Libraries mailing list