pure ==> return

.hlint.yaml

@@ -12,7 +12,7 @@
 - ignore: {name: "Use module export list"}
 - ignore: {name: "Use list literal pattern"}
 - ignore: {name: "Use void"}
-- ignore: {name: "Redundant return"}
+- ignore: {name: "Redundant pure"}
 - ignore: {name: "Redundant do"}
 - ignore: {name: "Move brackets to avoid $"}
 - ignore: {name: "Unused LANGUAGE pragma"}

src/Action/CmdLine.hs

@@ -79,24 +79,24 @@ data CmdLine
 defaultDatabaseLang :: Language -> IO FilePath
 defaultDatabaseLang lang = do
     dir <- getAppUserDataDirectory "hoogle"
-    return $ dir </> "default-" ++ lower (show lang) ++ "-" ++ showVersion (trimVersion 3 version) ++ ".hoo"
+    pure $ dir </> "default-" ++ lower (show lang) ++ "-" ++ showVersion (trimVersion 3 version) ++ ".hoo"
 
 getCmdLine :: [String] -> IO CmdLine
 getCmdLine args = do
     args <- withArgs args $ cmdArgsRun cmdLineMode
 
     -- fill in the default database
-    args <- if database args /= "" then return args else do
-        db <- defaultDatabaseLang $ language args; return args{database=db}
+    args <- if database args /= "" then pure args else do
+        db <- defaultDatabaseLang $ language args; pure args{database=db}
 
     -- fix up people using Hoogle 4 instructions
     args <- case args of
         Generate{..} | "all" `elem` include -> do
             putStrLn "Warning: 'all' argument is no longer required, and has been ignored."
-            return $ args{include = delete "all" include}
-        _ -> return args
+            pure $ args{include = delete "all" include}
+        _ -> pure args
 
-    return args
+    pure args
 
 
 defaultGenerate :: CmdLine

src/Action/Generate.hs

@@ -107,7 +107,7 @@ readHaskellOnline timing settings download = do
 
     cbl <- timed timing "Reading Cabal" $ parseCabalTarball settings cabals
     let want = Set.insert (strPack "ghc") $ Set.unions [setStackage, setPlatform, setGHC]
-    cbl <- return $ flip Map.mapWithKey cbl $ \name p ->
+    cbl <- pure $ flip Map.mapWithKey cbl $ \name p ->
         p{packageTags =
             [(strPack "set",strPack "included-with-ghc") | name `Set.member` setGHC] ++
             [(strPack "set",strPack "haskell-platform") | name `Set.member` setPlatform] ++
@@ -118,7 +118,7 @@ readHaskellOnline timing settings download = do
             tar <- liftIO $ tarballReadFiles hoogles
             forM_ tar $ \(strPack . takeBaseName -> name, src) ->
                 yield (name, hackagePackageURL name, src)
-    return (cbl, want, source)
+    pure (cbl, want, source)
 
 
 readHaskellDirs :: Timing -> Settings -> [FilePath] -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
@@ -136,15 +136,15 @@ readHaskellDirs timing settings dirs = do
             dir <- liftIO $ canonicalizePath $ takeDirectory file
             let url = "file://" ++ ['/' | not $ "/" `isPrefixOf` dir] ++ replace "\\" "/" dir ++ "/"
             yield (name, url, lbstrFromChunks [src])
-    return (Map.union
+    pure (Map.union
                 (Map.fromList cabals)
                 (Map.fromListWith (<>) $ map generateBarePackage packages)
            ,Set.fromList $ map fst packages, source)
   where
     parseCabal fp = do
         src <- readFileUTF8' fp
         let pkg = readCabal settings src
-        return (strPack $ takeBaseName fp, pkg)
+        pure (strPack $ takeBaseName fp, pkg)
 
     generateBarePackage (name, file) =
         (name, mempty{packageTags = (strPack "set", strPack "all") : sets})
@@ -158,7 +158,7 @@ readFregeOnline timing download = do
     let source = do
             src <- liftIO $ bstrReadFile frege
             yield (strPack "frege", "http://google.com/", lbstrFromChunks [src])
-    return (Map.empty, Set.singleton $ strPack "frege", source)
+    pure (Map.empty, Set.singleton $ strPack "frege", source)
 
 
 readHaskellGhcpkg :: Timing -> Settings -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
@@ -173,9 +173,9 @@ readHaskellGhcpkg timing settings = do
                     let url = "file://" ++ ['/' | not $ all isPathSeparator $ take 1 docs] ++
                               replace "\\" "/" (addTrailingPathSeparator docs)
                     yield (name, url, lbstrFromChunks [src])
-    cbl <- return $ let ts = map (both strPack) [("set","stackage"),("set","installed")]
+    cbl <- pure $ let ts = map (both strPack) [("set","stackage"),("set","installed")]
                     in Map.map (\p -> p{packageTags = ts ++ packageTags p}) cbl
-    return (cbl, Map.keysSet cbl, source)
+    pure (cbl, Map.keysSet cbl, source)
 
 readHaskellHaddock :: Timing -> Settings -> FilePath -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
 readHaskellHaddock timing settings docBaseDir = do
@@ -189,9 +189,9 @@ readHaskellHaddock timing settings docBaseDir = do
                     let url = ['/' | not $ all isPathSeparator $ take 1 docs] ++
                               replace "\\" "/" (addTrailingPathSeparator docs)
                     yield (name, url, lbstrFromChunks [src])
-    cbl <- return $ let ts = map (both strPack) [("set","stackage"),("set","installed")]
+    cbl <- pure $ let ts = map (both strPack) [("set","stackage"),("set","installed")]
                     in Map.map (\p -> p{packageTags = ts ++ packageTags p}) cbl
-    return (cbl, Map.keysSet cbl, source)
+    pure (cbl, Map.keysSet cbl, source)
 
     where docDir name Package{..} = name ++ "-" ++ strUnpack packageVersion
 
@@ -201,7 +201,7 @@ actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtensio
     createDirectoryIfMissing True $ takeDirectory database
     whenLoud $ putStrLn $ "Generating files to " ++ takeDirectory database
 
-    download <- return $ downloadInput timing insecure download (takeDirectory database)
+    download <- pure $ downloadInput timing insecure download (takeDirectory database)
     settings <- loadSettings
     (cbl, want, source) <- case language of
         Haskell | Just dir <- haddock -> readHaskellHaddock timing settings dir
@@ -217,8 +217,8 @@ actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtensio
     -- mtl is more popular than transformers, despite having dodgy docs, which is a shame, so we hack it
     popularity <- evaluate $ Map.adjust (max $ 1 + Map.findWithDefault 0 (strPack "mtl") popularity) (strPack "transformers") popularity
 
-    want <- return $ if include /= [] then Set.fromList $ map strPack include else want
-    want <- return $ case count of Nothing -> want; Just count -> Set.fromList $ take count $ Set.toList want
+    want <- pure $ if include /= [] then Set.fromList $ map strPack include else want
+    want <- pure $ case count of Nothing -> want; Just count -> Set.fromList $ take count $ Set.toList want
 
     (stats, _) <- storeWriteFile database $ \store -> do
         xs <- withBinaryFile (database `replaceExtension` "warn") WriteMode $ \warnings -> do
@@ -258,17 +258,17 @@ actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtensio
                                 else if null include then
                                     ret "Not on Stackage, so not searched.\n"
                                 else
-                                    return ()
+                                    pure ()
                             ))
                     .| pipelineC 10 (items .| sinkList)
 
                 itemWarn <- readIORef itemWarn
                 when (itemWarn > 0) $
                     putStrLn $ "Found " ++ show itemWarn ++ " warnings when processing items"
-                return [(a,b) | (a,bs) <- xs, b <- bs]
+                pure [(a,b) | (a,bs) <- xs, b <- bs]
 
         itemsMemory <- getStatsCurrentLiveBytes
-        xs <- timed timing "Reordering items" $ return $! reorderItems settings (\s -> maybe 1 negate $ Map.lookup s popularity) xs
+        xs <- timed timing "Reordering items" $ pure $! reorderItems settings (\s -> maybe 1 negate $ Map.lookup s popularity) xs
         timed timing "Writing tags" $ writeTags store (`Set.member` want) (\x -> maybe [] (map (both strUnpack) . packageTags) $ Map.lookup x cbl) xs
         timed timing "Writing names" $ writeNames store xs
         timed timing "Writing types" $ writeTypes store (if debug then Just $ dropExtension database else Nothing) xs

src/Action/Search.hs

@@ -39,8 +39,8 @@ actionSearch :: CmdLine -> IO ()
 actionSearch Search{..} = replicateM_ repeat_ $ -- deliberately reopen the database each time
     withSearch database $ \store ->
         if null compare_ then do
-            count' <- return $ fromMaybe 10 count
-            (q, res) <- return $ search store $ parseQuery $ unwords query
+            count' <- pure $ fromMaybe 10 count
+            (q, res) <- pure $ search store $ parseQuery $ unwords query
             whenLoud $ putStrLn $ "Query: " ++ unescapeHTML (LBS.unpack $ renderMarkup $ renderQuery q)
             let (shown, hidden) = splitAt count' $ nubOrd $ map (targetResultDisplay link) res
             if null res then
@@ -90,26 +90,26 @@ withSearch database act = do
 
 search :: StoreRead -> [Query] -> ([Query], [Target])
 search store qs = runIdentity $ do
-    (qs, exact, filt, list) <- return $ applyTags store  qs
+    (qs, exact, filt, list) <- pure $ applyTags store  qs
     is <- case (filter isQueryName qs, filter isQueryType qs) of
-        ([], [] ) -> return list
-        ([], t:_) -> return $ searchTypes store $ hseToSig $ fromQueryType t
-        (xs, [] ) -> return $ searchNames store exact $ map fromQueryName xs
+        ([], [] ) -> pure list
+        ([], t:_) -> pure $ searchTypes store $ hseToSig $ fromQueryType t
+        (xs, [] ) -> pure $ searchNames store exact $ map fromQueryName xs
         (xs, t:_) -> do
-            nam <- return $ Set.fromList $ searchNames store exact $ map fromQueryName xs
-            return $ filter (`Set.member` nam) $ searchTypes store $ hseToSig $ fromQueryType t
+            nam <- pure $ Set.fromList $ searchNames store exact $ map fromQueryName xs
+            pure $ filter (`Set.member` nam) $ searchTypes store $ hseToSig $ fromQueryType t
     let look = lookupItem store
-    return (qs, map look $ filter filt is)
+    pure (qs, map look $ filter filt is)
 
 action_search_test :: Bool -> FilePath -> IO ()
 action_search_test sample database = testing "Action.Search.search" $ withSearch database $ \store -> do
     let noResults a = do
-          res <- return $ snd $ search store (parseQuery a)
+          res <- pure $ snd $ search store (parseQuery a)
           case res of
               [] -> putChar '.'
               _ -> errorIO $ "Searching for: " ++ show a ++ "\nGot: " ++ show (take 1 res) ++ "\n expected none"
     let a ==$ f = do
-            res <- return $ snd $ search store (parseQuery a)
+            res <- pure $ snd $ search store (parseQuery a)
             case res of
                 Target{..}:_ | f targetURL -> putChar '.'
                 _ -> errorIO $ "Searching for: " ++ show a ++ "\nGot: " ++ show (take 1 res)

src/Action/Server.hs

@@ -61,8 +61,8 @@ actionServer cmd@Server{..} = do
         \x -> BS.pack "hoogle=" `BS.isInfixOf` x && not (BS.pack "is:ping" `BS.isInfixOf` x)
     putStrLn . showDuration =<< time
     evaluate spawned
-    dataDir <- maybe getDataDir return datadir
-    haddock <- maybe (return Nothing) (fmap Just . canonicalizePath) haddock
+    dataDir <- maybe getDataDir pure datadir
+    haddock <- maybe (pure Nothing) (fmap Just . canonicalizePath) haddock
     withSearch database $ \store ->
         server log cmd $ replyServer log local links haddock store cdn home (dataDir </> "html") scope
 
@@ -118,9 +118,9 @@ replyServer log local links haddock store cdn home htmlDir scope Input{..} = cas
                   filteredResults = take count $ drop start results
               in case lookup "format" inputArgs of
                 Just "text" -> pure $ OutputJSON $ JSON.toEncoding $ map unHTMLTarget filteredResults
-                Just f -> return $ OutputFail $ lbstrPack $ "Format mode " ++ f ++ " not (currently) supported"
+                Just f -> pure $ OutputFail $ lbstrPack $ "Format mode " ++ f ++ " not (currently) supported"
                 Nothing -> pure $ OutputJSON $ JSON.toEncoding filteredResults
-            Just m -> return $ OutputFail $ lbstrPack $ "Mode " ++ m ++ " not (currently) supported"
+            Just m -> pure $ OutputFail $ lbstrPack $ "Mode " ++ m ++ " not (currently) supported"
     ["plugin","jquery.js"] -> OutputFile <$> JQuery.file
     ["plugin","jquery.flot.js"] -> OutputFile <$> Flot.file Flot.Flot
     ["plugin","jquery.flot.time.js"] -> OutputFile <$> Flot.file Flot.FlotTime
@@ -130,7 +130,7 @@ replyServer log local links haddock store cdn home htmlDir scope Input{..} = cas
         summ <- logSummary log
         let errs = sum [summaryErrors | Summary{..} <- summ, summaryDate >= pred (utctDay now)]
         let alive = fromRational $ toRational $ (now `diffUTCTime` spawned) / (24 * 60 * 60)
-        return $ (if errs == 0 && alive < 1.5 then OutputText else OutputFail) $ lbstrPack $
+        pure $ (if errs == 0 && alive < 1.5 then OutputText else OutputFail) $ lbstrPack $
             "Errors " ++ (if errs == 0 then "good" else "bad") ++ ": " ++ show errs ++ " in the last 24 hours.\n" ++
             "Updates " ++ (if alive < 1.5 then "good" else "bad") ++ ": Last updated " ++ showDP 2 alive ++ " days ago.\n"
 
@@ -141,24 +141,24 @@ replyServer log local links haddock store cdn home htmlDir scope Input{..} = cas
         OutputJavascript <$> templateRender templateLogJs [("data",html $ H.preEscapedString log)]
     ["stats"] -> do
         stats <- getStatsDebug
-        return $ case stats of
+        pure $ case stats of
             Nothing -> OutputFail $ lbstrPack "GHC Statistics is not enabled, restart with +RTS -T"
             Just x -> OutputText $ lbstrPack $ replace ", " "\n" $ takeWhile (/= '}') $ drop1 $ dropWhile (/= '{') $ show x
     "haddock":xs | Just x <- haddock -> do
         let file = intercalate "/" $ x:xs
-        return $ OutputFile $ file ++ (if hasTrailingPathSeparator file then "index.html" else "")
+        pure $ OutputFile $ file ++ (if hasTrailingPathSeparator file then "index.html" else "")
     "file":xs | local -> do
         let x = ['/' | not isWindows] ++ intercalate "/" (dropWhile null xs)
         let file = x ++ (if hasTrailingPathSeparator x then "index.html" else "")
         if takeExtension file /= ".html" then
-            return $ OutputFile file
+            pure $ OutputFile file
          else do
             src <- readFile file
             -- Haddock incorrectly generates file:// on Windows, when it should be file:///
             -- so replace on file:// and drop all leading empty paths above
-            return $ OutputHTML $ lbstrPack $ replace "file://" "/file/" src
+            pure $ OutputHTML $ lbstrPack $ replace "file://" "/file/" src
     xs ->
-        return $ OutputFile $ joinPath $ htmlDir : xs
+        pure $ OutputFile $ joinPath $ htmlDir : xs
     where
         html = templateMarkup
         text = templateMarkup . H.string
@@ -241,7 +241,7 @@ showFroms local haddock xs = mconcat $ intersperse ", " $ flip map pkgs $ \p ->
     let ms = filter ((==) p . targetPackage) xs
     in mconcat $ intersperse " " [H.a ! H.href (H.stringValue $ showURL local haddock b) $ H.string a | (a,b) <- catMaybes $ p : map remod ms]
     where
-        remod Target{..} = do (a,_) <- targetModule; return (a,targetURL)
+        remod Target{..} = do (a,_) <- targetModule; pure (a,targetURL)
         pkgs = nubOrd $ map targetPackage xs
 
 showURL :: Bool -> Maybe FilePath -> URL -> String

src/General/Conduit.hs

@@ -74,7 +74,7 @@ pipelineC buffer sink = do
                 x <- liftIO $ readChan chan
                 liftIO $ signalQSem sem
                 whenJust x yield
-                return $ isJust x) .|
+                pure $ isJust x) .|
             sink
     awaitForever $ \x -> liftIO $ do
         waitQSem sem

src/General/Log.hs

@@ -36,23 +36,23 @@ showTime :: UTCTime -> String
 showTime = showUTCTime "%Y-%m-%dT%H:%M:%S%Q"
 
 logNone :: IO Log
-logNone = do ref <- newIORef Map.empty; return $ Log Nothing ref (const False)
+logNone = do ref <- newIORef Map.empty; pure $ Log Nothing ref (const False)
 
 logCreate :: Either Handle FilePath -> (BS.ByteString -> Bool) -> IO Log
 logCreate store interesting = do
     (h, old) <- case store of
-        Left h -> return (h, Map.empty)
+        Left h -> pure (h, Map.empty)
         Right file -> do
             b <- doesFileExist file
-            mp <- if not b then return Map.empty else withFile file ReadMode $ \h -> do
+            mp <- if not b then pure Map.empty else withFile file ReadMode $ \h -> do
                 src <- LBS.hGetContents h
                 let xs = mapMaybe (parseLogLine interesting . LBS.toStrict) $ LBS.lines src
-                return $! foldl' (\mp (k,v) -> Map.alter (Just . maybe v (<> v)) k mp) Map.empty xs
+                pure $! foldl' (\mp (k,v) -> Map.alter (Just . maybe v (<> v)) k mp) Map.empty xs
             (,mp) <$> openFile file AppendMode
     hSetBuffering h LineBuffering
     var <- newVar h
     ref <- newIORef old
-    return $ Log (Just var) ref (interesting . BS.pack)
+    pure $ Log (Just var) ref (interesting . BS.pack)
 
 logAddMessage :: Log -> String -> IO ()
 logAddMessage Log{..} msg = do
@@ -69,7 +69,7 @@ logAddEntry Log{..} user question taken err = do
      else if isJust err then
         add mempty{iErrors=1}
      else
-        return ()
+        pure ()
     whenJust logOutput $ \var -> withVar var $ \h ->
         hPutStrLn h $ unwords $ [showTime time, user, showDP 3 taken, question] ++
                                 maybeToList (fmap ((++) "ERROR: " . unwords . words) err)

src/General/Store.hs

@@ -90,7 +90,7 @@ instance forall a . (Typeable a, Storable a) => Stored (V.Vector a) where
         storeWriteAtom store k part (castPtr ptr, V.length v * sizeOf (undefined :: a))
     storedRead store k = storeReadAtom store k $ \(ptr, len) -> do
         ptr <- newForeignPtr_ $ castPtr ptr
-        return $ V.unsafeFromForeignPtr0 ptr (len `div` sizeOf (undefined :: a))
+        pure $ V.unsafeFromForeignPtr0 ptr (len `div` sizeOf (undefined :: a))
 
 
 ---------------------------------------------------------------------
@@ -130,7 +130,7 @@ storeWriteFile file act = do
         let stats = prettyTable 0 "Bytes" $
                 ("Overheads", intToDouble $ fromIntegral final - sum (map atomSize $ Map.elems atoms)) :
                 [(name ++ " :: " ++ atomType, intToDouble atomSize) | (name, Atom{..}) <- Map.toList atoms]
-        return (stats, res)
+        pure (stats, res)
 
 storeWrite :: (Typeable (t a), Typeable a, Stored a) => StoreWrite -> t a -> a -> IO ()
 storeWrite store k = storedWrite store k False
@@ -151,8 +151,8 @@ storeWriteAtom (StoreWrite ref) (show . typeOf -> key) part (ptr, len) = do
         (keyOld,a):xs | part, key == keyOld -> do
             let size = atomSize a + len
             evaluate size
-            return $ (key,a{atomSize=size}) : xs
-        _ -> return $ (key, Atom val swPosition len) : swAtoms
+            pure $ (key,a{atomSize=size}) : xs
+        _ -> pure $ (key, Atom val swPosition len) : swAtoms
     writeIORef' ref sw{swPosition = swPosition + len, swAtoms = atoms}