Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated about an hour ago

total matches: 117

Unique-0.4.7.6
2 matches
Data/List/Unique.hs

import           Control.Applicative (liftA2)
import           Data.Function       (on)
import           Data.List.Extra     (nubOrd)
import           Data.Tuple          (swap)

-- | 'sortUniq' sorts the list and removes the duplicates of elements. Example:
--
-- > sortUniq "foo bar" == " abfor"

            
Data/List/Unique.hs
-- > sortUniq "foo bar" == " abfor"

sortUniq :: Ord a => [a] -> [a]
sortUniq = sort . nubOrd

sg :: Ord a => [a] -> [[a]]
sg = group . sort

filterByLength :: Ord a => (Int -> Bool) -> [a] -> [[a]]

            
algebraic-graphs-0.4
1 matches
test/Algebra/Graph/Test.hs
    ) where

import Data.List (sort)
import Data.List.Extra (nubOrd)
import Prelude hiding ((+), (*))
import System.Exit (exitFailure)
import Test.QuickCheck hiding ((===))
import Test.QuickCheck.Function
import Test.QuickCheck.Test (isSuccess)

            
bake-0.5
7 matches
src/Development/Bake/Server/Brain.hs
                    str_ " rejected due to " <> showTestAt (point p) t
                    whenJust (failingTestOutput store (point p) t) $ \s ->
                        br_ <> br_ <> pre_ (summary s)
                | (p,t) <- nubOrdOn fst xs, let PatchInfo{..} = storePatch store p]

        store <- storeUpdate store
            [IUReject p t (point p) | (p,t) <- xs]
        return $ bad mem{store = store}


            
src/Development/Bake/Server/Brain.hs
3) anyone not done in active
-}
output info mem@Memory{..} Ping{..}
    | False, pNowThreads == pMaxThreads, isNothing res = error $ show (enoughThreads $ listToMaybe $ filter suitable $ nubOrd $ concatMap dependencies $ bad ++ good, filter suitable good, concatMap dependencies $ bad ++ good, bad, good)
    | otherwise = res
    where
        res = fmap question $ enoughThreads $ listToMaybe $ filter suitable $ nubOrd $ concatMap dependencies $ bad ++ good

        self = storePoint store active
        failedSelf = Set.toList $ poFail self
        failedPrefix = Map.fromListWith mappend $
            [ (t, case poTest po t of Just True -> ([i],[]); Just False -> ([],[i]); Nothing -> ([],[]))

            
src/Development/Bake/Server/Memory.hs
    messages <- return $ concat [(a,b) : map (,b) (admins mem) | (a,b) <- messages]
    res <- try_ $ forM_ (groupSort messages) $ \(author, body) -> do
        let nl = br_ <> str_ "\n" -- important to include lots of lines or Outlook gets upset
        ovenNotify (oven mem) author subject $ renderHTML $ mconcat $ intersperse (nl <> nl) $ nubOrd body
    return $ \mem -> mem{fatal = ["Notification failure: " ++ show e | Left e <- [res]] ++ fatal mem}

notifyAdmins :: Memory -> String -> HTML -> IO (Memory -> Memory)
notifyAdmins mem subject message = notify mem subject $ map (,message) $ admins mem


            
src/General/Database.hs
-- important to produce name before looking at columns
table name rowid (columns -> keys) (columns -> cols) = Table name (check keys) (check cols)
    where
        check x | nubOrd (map colTable $ keys ++ cols) /= [name] = error "Column with the wrong table"
                | not $ null $ map colName keys \\ map colName cols = error "Key column which is not one of the normal columns"
                | colName rowid `notElem` ["","rowid"] = error "Rowid column must have name rowid"
                | otherwise = x

column :: forall c rowid cs . TypeField c => Table rowid cs -> String -> Column c

            
src/General/Database.hs
sqlUpdate conn upd pred = do
    let (updCs, updVs) = unzip $ map unupdate upd
    let (prdStr, _, prdCs, prdVs) = unpred pred
    let tbl = nubOrd $ map colTable $ updCs ++ prdCs
    case tbl of
        _ | null upd -> fail "Must update at least one column"
        [t] -> do
            let str = "UPDATE " ++ t ++ " SET " ++ intercalate ", " (map ((++ "=?") . colName) updCs) ++ " WHERE " ++ prdStr
            execute conn (fromString str) (updVs ++ prdVs)

            
src/General/Database.hs
sqlDelete :: Connection -> Table rowid cs -> [Pred] -> IO ()
sqlDelete conn tbl pred = do
    let (prdStr, _, prdCs, prdVs) = unpred pred
    case nubOrd $ tblName tbl : map colTable prdCs of
        [t] -> do
            let str = "DELETE FROM " ++ t ++ " WHERE " ++ prdStr
            execute conn (fromString str) prdVs
        ts -> fail $ "sqlDelete, can only delete from one table but you are touching: " ++ unwords ts


            
src/General/Database.hs
    let outCs = columns cols
    let (prdStr, prdDs, prdCs, prdVs) = unpred pred
    let str = "SELECT " ++ intercalate ", " [(if c `elem` prdDs then "DISTINCT " else "") ++ colTable ++ "." ++ colName | c@Column{..} <- outCs] ++ " " ++
              "FROM " ++ intercalate ", " (nubOrd $ map colTable $ outCs ++ prdCs) ++ " WHERE " ++ prdStr
    query conn (fromString str) prdVs


sqlEnsureTable :: Connection -> Table rowid cs -> IO ()
sqlEnsureTable conn Table{..} = do

            
bdcs-api-0.1.3
3 matches
src/BDCS/API/V0.hs
import           Data.Either(partitionEithers, rights)
import           Data.Int(Int64)
import           Data.List(find, sortBy)
import           Data.List.Extra(nubOrd)
import           Data.Maybe(fromMaybe, mapMaybe)
import           Data.String(IsString)
import           Data.String.Conversions(ConvertibleStrings, cs)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

            
src/BDCS/API/V0.hs
        Left  _                 ->
            return $ ModulesListResponse [] offset limit 0
        Right (tuples, total64) ->
            let names = nubOrd $ map snd tuples
                objs = map mkModuleName names
            in  return $ ModulesListResponse objs offset limit (fromIntegral total64)
  where
    -- | Return the offset or the default
    offset :: Int

            
src/BDCS/API/V0.hs
    result <- runExceptT $ flip runSqlPool cfgPool $ concatMapM (fmap fst . getGroupsLike Nothing Nothing) module_names_list
    case result of
        Left _       -> return $ ModulesListResponse [] offset limit 0
        Right tuples -> let names = nubOrd $ sortBy caseInsensitiveT $ map snd tuples
                            total = length names
                            objs = applyLimits limit offset $ map mkModuleName names
                        in  return $ ModulesListResponse objs offset limit total
  where
    -- | Return the offset or the default

            
brittany-0.12.1.0
1 matches
src/Language/Haskell/Brittany/Internal/Prelude.hs
import Data.Version                  as E ( showVersion
                                          )

import Data.List.Extra               as E ( nubOrd
                                          , stripSuffix
                                          )
import Control.Monad.Extra           as E ( whenM
                                          , unlessM
                                          , ifM

            
buildwrapper-0.9.1
1 matches
src/Language/Haskell/BuildWrapper/GHC.hs
                getRemovedImports allImps ftm= let 
                        cleanedLines=DS.fromList $ map (\(L l _,_)->iflLine $ifsStart $ ghcSpanToLocation l) $ DM.elems ftm
                        missingImps=filter (\(_,(L l imp,_))->not $ ideclImplicit imp || DS.member (iflLine $ifsStart $ ghcSpanToLocation l) cleanedLines) allImps
                        in nubOrd $ map (\(_,(L l _,_))-> ImportClean (ghcSpanToLocation l) "") missingImps
                getFormatInfo :: FinalImportValue -> (Int,Int,Int,Int,Int)->(Int,Int,Int,Int,Int)
                getFormatInfo (L _ imp,_) (szSafe,szQualified,szPkg,szName,szAs)=let
                        szSafe2=if ideclSafe imp then 5 else szSafe
                        szQualified2=if ideclQualified imp then 10 else szQualified
                        szPkg2=maybe szPkg (\p->max szPkg (3 + lengthFS p)) $ ideclPkgQual imp

            
debug-0.1.1
2 matches
src/Debug/DebugTrace.hs
debugPrintTrace :: DebugTrace -> IO ()
debugPrintTrace trace@DebugTrace{..} = do
    let concs = getTraceVars trace
    let docs = map call $ nubOrd $ reverse concs
    putDoc (vcat docs <> hardline)
    where
          call :: (Function, [(Text, Text)]) -> Doc
          call (f, vs) =
                   let ass = vs

            
src/Debug/Variables.hs
  vars <- readIORef refVariables
  vars <- return $ map varShow $ listVariables vars
  calls <- readIORef refCalls
  let infos = nubOrd [x | Call x _ <- calls]
      infoId = HM.fromList $ zip infos [0::Int ..]
  callEntries <-
    forM (reverse calls) $ \(Call info vars) -> do
      vars <- readIORef vars
      let callFunctionId   = infoId HM.! info

            
extra-1.6.18
4 matches
src/Data/List/Extra.hs
    enumerate,
    -- * List operations
    groupSort, groupSortOn, groupSortBy,
    nubOrd, nubOrdBy, nubOrdOn,
    nubOn, groupOn,
    nubSort, nubSortBy, nubSortOn,
    maximumOn, minimumOn,
    disjoint, allSame, anySame,
    repeatedly, for, firstJust,

            
src/Data/List/Extra.hs
          f (x:xs) = x : f xs
          f [] = []

-- | /O(n log n)/. The 'nubOrd' function removes duplicate elements from a list.
-- In particular, it keeps only the first occurrence of each element.
-- Unlike the standard 'nub' operator, this version requires an 'Ord' instance
-- and consequently runs asymptotically faster.
--
-- > nubOrd "this is a test" == "this ae"

            
src/Data/List/Extra.hs
-- Unlike the standard 'nub' operator, this version requires an 'Ord' instance
-- and consequently runs asymptotically faster.
--
-- > nubOrd "this is a test" == "this ae"
-- > nubOrd (take 4 ("this" ++ undefined)) == "this"
-- > \xs -> nubOrd xs == nub xs
nubOrd :: Ord a => [a] -> [a]
nubOrd = nubOrdBy compare

-- | A version of 'nubOrd' which operates on a portion of the value.
--
-- > nubOrdOn length ["a","test","of","this"] == ["a","test","of"]
nubOrdOn :: Ord b => (a -> b) -> [a] -> [a]
nubOrdOn f = map snd . nubOrdBy (compare `on` fst) . map (f &&& id)

-- | A version of 'nubOrd' with a custom predicate.
--
-- > nubOrdBy (compare `on` length) ["a","test","of","this"] == ["a","test","of"]
nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy cmp xs = f E xs
    where f seen [] = []
          f seen (x:xs) | memberRB cmp x seen = f seen xs
                        | otherwise = x : f (insertRB cmp x seen) xs

---------------------------------------------------------------------

            
src/Extra.hs
    writeIORef', atomicWriteIORef', atomicModifyIORef_, atomicModifyIORef'_,
    -- * Data.List.Extra
    -- | Extra functions available in @"Data.List.Extra"@.
    lower, upper, trim, trimStart, trimEnd, word1, line1, escapeHTML, escapeJSON, unescapeHTML, unescapeJSON, dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd, dropPrefix, dropSuffix, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, notNull, list, unsnoc, cons, snoc, drop1, mconcatMap, enumerate, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, nubOn, groupOn, nubSort, nubSortBy, nubSortOn, maximumOn, minimumOn, disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip, concatUnzip3, zipFrom, zipWithFrom, replace, merge, mergeBy,
    -- * Data.List.NonEmpty.Extra
    -- | Extra functions available in @"Data.List.NonEmpty.Extra"@.
    (|:), (|>), appendl, appendr, maximum1, minimum1, maximumBy1, minimumBy1, maximumOn1, minimumOn1,
    -- * Data.Tuple.Extra
    -- | Extra functions available in @"Data.Tuple.Extra"@.

            
filepattern-0.1.1
1 matches
src/System/FilePattern/Step.hs
        f rest (StepOnly x:xs) = f (rest . (x ++)) xs

normaliseStepNext :: StepNext -> StepNext
normaliseStepNext (StepOnly xs) = StepOnly $ nubOrd xs
normaliseStepNext x = x


instance Semigroup StepNext where
    a <> b = sconcat $ NE.fromList [a,b]

            
ghcid-0.7.6
8 matches
src/Ghcid.hs
                outStrLn $ "%VERSION: " ++ showVersion version
            withCurrentDirectory (directory opts) $ do
                opts <- autoOptions opts
                opts <- return $ opts{restart = nubOrd $ (origDir </> ".ghcid") : restart opts, reload = nubOrd $ reload opts}
                when (topmost opts) terminalTopmost

                let noHeight = if no_height_limit opts then const Nothing else id
                termSize <- return $ case (width opts, height opts) of
                    (Just w, Just h) -> return $ TermSize w (noHeight $ Just h) WrapHard

            
src/Ghcid.hs
        putStrLn $ "\nNo files loaded, GHCi is not working properly.\nCommand: " ++ command
        exitFailure

    restart <- return $ nubOrd $ restart ++ [x | LoadConfig x <- messages]
    -- Note that we capture restarting items at this point, not before invoking the command
    -- The reason is some restart items may be generated by the command itself
    restartTimes <- mapM getModTime restart

    project <- if project /= "" then return project else takeFileName <$> getCurrentDirectory

            
src/Ghcid.hs
            updateTitle $ if isJust test then "(running test)" else ""

            -- order and restrict the messages
            -- nubOrdOn loadMessage because module cycles generate the same message at several different locations
            ordMessages <- do
                let (msgError, msgWarn) = partition ((==) Error . loadSeverity) $ nubOrdOn loadMessage $ filter isMessage messages
                -- sort error messages by modtime, so newer edits cause the errors to float to the top - see #153
                errTimes <- sequence [(x,) <$> getModTime x | x <- nubOrd $ map loadFile msgError]
                let f x = lookup (loadFile x) errTimes
                    moduleSorted = sortOn (Down . f) msgError ++ msgWarn
                return $ (if reverse_errors then reverse else id) moduleSorted

            outputFill currTime (Just (loadedCount, ordMessages)) evals [test_message | isJust test]

            
src/Language/Haskell/Ghcid/Parser.hs
-- | Parse messages given on reload.
parseLoad :: [String] -> [Load]
-- nub, because cabal repl sometimes does two reloads at the start
parseLoad (map Esc -> xs) = nubOrd $ f xs
    where
        f :: [Esc] -> [Load]

        -- [1 of 2] Compiling GHCi             ( GHCi.hs, interpreted )
        f (xs:rest)

            
src/Language/Haskell/Ghcid/Parser.hs
            | unescapeE x == "Module imports form a cycle:"
            , (xs,rest) <- span (isPrefixOfE " ") xs
            , let ms = [takeWhile (/= ')') x | x <- xs, '(':x <- [dropWhile (/= '(') $ unescapeE x]]
            = [Message Error m (0,0) (0,0) (map fromEsc $ x:xs) | m <- nubOrd ms] ++ f rest

        -- Loaded GHCi configuration from C:\Neil\ghcid\.ghci
        f (x:xs)
            | Just x <- stripPrefixE "Loaded GHCi configuration from " x
            = LoadConfig (unescapeE x) : f xs

            
src/Session.hs
    showCursor

loadedModules :: [Load] -> [FilePath]
loadedModules = nubOrd . map loadFile . filter (not . isLoadConfig)

qualify :: FilePath -> [Load] -> [Load]
qualify dir xs = [x{loadFile = dir </> loadFile x} | x <- xs]

-- | Spawn a new Ghci process at a given command line. Returns the load messages, plus

            
src/Session.hs
        messages <- return $ messages ++ filter validWarn warn

        writeIORef warnings $ getWarnings messages
        return (messages ++ evals, nubOrd $ loaded ++ reloaded)


-- | Run an exec operation asynchronously. Should not be a @:reload@ or similar.
--   Will be automatically aborted if it takes too long. Only fires done if not aborted.
--   Argument to done is the final stderr line.

            
src/Wait.hs
        case waiter of
            WaiterPoll t -> return ()
            WaiterNotify manager kick mp -> do
                dirs <- fmap Set.fromList $ mapM canonicalizePathSafe $ nubOrd $ map takeDirectory files
                modifyVar_ mp $ \mp -> do
                    let (keep,del) = Map.partitionWithKey (\k v -> k `Set.member` dirs) mp
                    sequence_ $ Map.elems del
                    new <- forM (Set.toList $ dirs `Set.difference` Map.keysSet keep) $ \dir -> do
                        can <- watchDir manager (fromString dir) (const True) $ \event -> do