diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs index c2feb4e..ed28662 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs @@ -89,7 +89,7 @@ streamStringOutIO f getChunk = go handle = do chunk <- getChunk case chunk of - Nothing -> return () + Nothing -> pure () Just c -> do IO.liftIO $ Bytes.hPut handle c go handle diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs index 2cbadf2..0a28fef 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs @@ -89,7 +89,7 @@ runParser effs (NarParser action) h target = do Reader.runReaderT (Except.runExceptT $ State.evalStateT action state0) effs `Exception.Lifted.catch` exceptionHandler when (Either.isLeft unpackResult) cleanup - return unpackResult + pure unpackResult where state0 :: ParserState @@ -103,7 +103,7 @@ runParser effs (NarParser action) h target = do exceptionHandler :: Exception.Lifted.SomeException -> m (Either String a) exceptionHandler e = - return $ Left $ "Exception while unpacking NAR file: " <> show e + pure $ Left $ "Exception while unpacking NAR file: " <> show e cleanup :: m () cleanup = @@ -141,7 +141,7 @@ data ParserState = ParserState -- | Parse a NAR byte string, producing @()@. -- Parsing a NAR is mostly used for its side-effect: producing --- the file system objects packed in the NAR. That's why we return @()@ +-- the file system objects packed in the NAR. That's why we pure @()@ parseNar :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseNar = do expectStr "nix-archive-1" @@ -179,7 +179,7 @@ parseSymlink = do currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) currentDirectoryAndFile = do dirStack <- State.gets directoryStack - return (List.foldr1 () (List.reverse $ drop 1 dirStack), head dirStack) + pure (List.foldr1 () (List.reverse $ drop 1 dirStack), head dirStack) -- | Internal data type representing symlinks encountered in the NAR @@ -224,7 +224,7 @@ parseFile = do getChunk = do bytesLeft <- IO.liftIO $ IORef.readIORef bytesLeftVar if bytesLeft == 0 - then return Nothing + then pure Nothing else do chunk <- IO.liftIO $ Bytes.hGetSome narHandle $ fromIntegral $ min 10000 bytesLeft when (Bytes.null chunk) (Fail.fail "ZERO BYTES") @@ -234,7 +234,7 @@ parseFile = do -- clean up chunks from previous runs. Without it, heap memory usage can -- quickly spike IO.liftIO $ Concurrent.threadDelay 10 - return $ Just chunk + pure $ Just chunk target <- currentFile streamFile <- Reader.asks Nar.narStreamFile @@ -373,7 +373,7 @@ parens act = do expectStr "(" r <- act expectStr ")" - return r + pure r -- | Sort links in the symlink stack according to their connectivity @@ -406,7 +406,7 @@ createLinks = do (linkPWD l linkTarget l) fileAbsPath <- Directory.canonicalizePath (linkFile l) - return (fileAbsPath, targetAbsPath) + pure (fileAbsPath, targetAbsPath) let linkGraph = Graph.edges canonicalLinks case Graph.topSort linkGraph of Left _ -> error "Symlinks form a loop" @@ -414,7 +414,7 @@ createLinks = do let sortedLinks = flip Map.lookup linkLocations <$> sortedNodes in - return $ catMaybes sortedLinks + pure $ catMaybes sortedLinks ------------------------------------------------------------------------------ @@ -426,7 +426,7 @@ consume :: (IO.MonadIO m, Fail.MonadFail m) => Int -> NarParser m ByteString -consume 0 = return "" +consume 0 = pure "" consume n = do state0 <- State.get newBytes <- IO.liftIO $ Bytes.hGetSome (handle state0) (max 0 n) @@ -434,7 +434,7 @@ consume n = do Fail.fail $ "consume: Not enough bytes in handle. Wanted " <> show n <> " got " <> show (Bytes.length newBytes) - return newBytes + pure newBytes -- | Pop a string off the token stack @@ -442,10 +442,10 @@ popStr :: Monad m => NarParser m (Maybe Text) popStr = do s <- State.get case List.uncons (tokenStack s) of - Nothing -> return Nothing + Nothing -> pure Nothing Just (x, xs) -> do State.put $ s { tokenStack = xs } - return $ Just x + pure $ Just x -- | Push a string onto the token stack @@ -472,7 +472,7 @@ popFileName = currentFile :: Monad m => NarParser m FilePath currentFile = do dirStack <- State.gets directoryStack - return $ List.foldr1 () $ List.reverse dirStack + pure $ List.foldr1 () $ List.reverse dirStack -- | Add a link to the collection of encountered symlinks diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs index 13a1453..f1df605 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs @@ -83,7 +83,7 @@ streamNarIO yield effs basePath = do yield $ str "(" r <- act yield $ str ")" - return r + pure r -- Read, yield, and pad the file yieldFile :: FilePath -> Int64 -> m () diff --git a/hnix-store-core/tests/NarFormat.hs b/hnix-store-core/tests/NarFormat.hs index 1392b70..4759a82 100644 --- a/hnix-store-core/tests/NarFormat.hs +++ b/hnix-store-core/tests/NarFormat.hs @@ -159,7 +159,7 @@ unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do let go dir = do srcHere <- doesDirectoryExist dir case srcHere of - False -> return () + False -> pure () True -> do IO.withFile narFilePath IO.WriteMode $ \h -> buildNarIO narEffectsIO "src" h @@ -231,7 +231,7 @@ test_streamManyFilesToNar = HU.testCaseSteps "streamManyFilesToNar" $ \step -> IO.withFile "hnar" IO.WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h filesPostcount <- countProcessFiles - return $ filesPostcount - filesPrecount + pure $ filesPostcount - filesPrecount step "create test files" Directory.createDirectory packagePath @@ -316,7 +316,7 @@ assertBoundedMemory = do bytes <- max_live_bytes <$> getRTSStats bytes < 100 * 1000 * 1000 `shouldBe` True #else - return () + pure () #endif @@ -358,7 +358,7 @@ packThenExtract testName setup = _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h -> unpackNarIO narEffectsIO h outputFile - return () + pure () -- | Count file descriptors owned by the current process countProcessFiles :: IO Int @@ -366,7 +366,7 @@ countProcessFiles = do pid <- Unix.getProcessID let fdDir = "/proc/" ++ show pid ++ "/fd" fds <- P.readProcess "ls" [fdDir] "" - return $ length $ words fds + pure $ length $ words fds -- | Read the binary output of `nix-store --dump` for a filepath @@ -601,7 +601,7 @@ instance Arbitrary FileSystemObject where arbDirectory n = fmap (Directory . Map.fromList) $ replicateM n $ do nm <- arbName f <- oneof [arbFile, arbDirectory (n `div` 2)] - return (nm,f) + pure (nm,f) ------------------------------------------------------------------------------ -- | Serialize Nar to lazy ByteString @@ -615,7 +615,7 @@ putNar (Nar file) = header <> parens (putFile file) strs ["type", "regular"] >> (if isExec == Nar.Executable then strs ["executable", ""] - else return ()) + else pure ()) >> putContents fSize contents putFile (SymLink target) = @@ -678,13 +678,13 @@ getNar = fmap Nar $ header >> parens getFile >> assertStr "") assertStr_ "contents" (fSize, contents) <- sizedStr - return $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents + pure $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents getDirectory = do assertStr_ "type" assertStr_ "directory" fs <- many getEntry - return $ Directory (Map.fromList fs) + pure $ Directory (Map.fromList fs) getSymLink = do assertStr_ "type" @@ -700,7 +700,7 @@ getNar = fmap Nar $ header >> parens getFile assertStr_ "node" file <- parens getFile maybe (fail $ "Bad FilePathPart: " ++ show name) - (return . (,file)) + (pure . (,file)) (filePathPart $ E.encodeUtf8 name) -- Fetch a length-prefixed, null-padded string @@ -710,7 +710,7 @@ getNar = fmap Nar $ header >> parens getFile n <- getInt64le s <- getLazyByteString n _ <- getByteString . fromIntegral $ padLen n - return (n,s) + pure (n,s) parens m = assertStr "(" *> m <* assertStr ")" @@ -718,5 +718,5 @@ getNar = fmap Nar $ header >> parens getFile assertStr s = do s' <- str if s == s' - then return s + then pure s else fail "No" diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 1a3abfa..8a219ee 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -170,7 +170,7 @@ buildDerivation p drv buildMode = do putInt 0 res <- getSocketIncremental $ getBuildResult - return res + pure res ensurePath :: StorePath -> MonadStore () ensurePath pn = do @@ -189,13 +189,13 @@ findRoots = do <*> getPath sd r <- catRights res - return $ Data.Map.Strict.fromList r + pure $ Data.Map.Strict.fromList r where catRights :: [(a, Either String b)] -> MonadStore [(a, b)] catRights = mapM ex ex :: (a, Either [Char] b) -> MonadStore (a, b) - ex (x , Right y) = return (x, y) + ex (x , Right y) = pure (x, y) ex (_x, Left e ) = error $ "Unable to decode root: " ++ e isValidPathUncached :: StorePath -> MonadStore Bool @@ -263,7 +263,7 @@ queryPathInfoUncached path = do trust = if ultimate then BuiltLocally else BuiltElsewhere - return $ StorePathMetadata{..} + pure $ StorePathMetadata{..} queryReferrers :: StorePath -> MonadStore StorePathSet queryReferrers p = do @@ -311,7 +311,7 @@ queryMissing ps = do unknown <- sockGetPaths downloadSize' <- sockGetInt narSize' <- sockGetInt - return (willBuild, willSubstitute, unknown, downloadSize', narSize') + pure (willBuild, willSubstitute, unknown, downloadSize', narSize') optimiseStore :: MonadStore () optimiseStore = void $ simpleOp OptimiseStore diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs index 0e4dd31..b09705e 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs @@ -47,7 +47,7 @@ getByteStringLen = do when (len `mod` 8 /= 0) $ do pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) unless (all (== 0) pads) $ fail $ "No zeroes" ++ show (st, len, pads) - return $ BSL.toStrict st + pure $ BSL.toStrict st where unpad x = sequence $ replicate x getWord8 getByteStrings :: Get [ByteString] diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs index 30b1f84..7f6064b 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs @@ -49,8 +49,8 @@ processOutput = go decoder go :: Decoder Logger -> MonadStore [Logger] go (Done _leftover _consumed ctrl) = do case ctrl of - e@(Error _ _) -> return [e] - Last -> return [Last] + e@(Error _ _) -> pure [e] + Last -> pure [Last] Read _n -> do (mdata, _) <- get case mdata of @@ -61,12 +61,12 @@ processOutput = go decoder clearData next <- go decoder - return next + pure next -- we should probably handle Read here as well x -> do next <- go decoder - return $ x : next + pure $ x : next go (Partial k) = do soc <- asks storeSocket chunk <- liftIO (Just <$> recv soc 8) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs index 640ce83..f6dc57b 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs @@ -35,7 +35,7 @@ caText :: Parser ContentAddressableAddress caText = do _ <- "text:sha256:" digest <- decodeBase @'SHA256 Base32 <$> parseHash - either fail return $ Text <$> digest + either fail pure $ Text <$> digest -- | Parser for @fixed:::@ caFixed :: Parser ContentAddressableAddress @@ -43,7 +43,7 @@ caFixed = do _ <- "fixed:" narHashMode <- (pure Recursive <$> "r:") <|> (pure RegularFile <$> "") digest <- parseTypedDigest - either fail return $ Fixed narHashMode <$> digest + either fail pure $ Fixed narHashMode <$> digest parseTypedDigest :: Parser (Either String SomeNamedDigest) parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs index 5bf1585..5f844df 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -122,7 +122,7 @@ opNum QueryMissing = 40 simpleOp :: WorkerOp -> MonadStore Bool -simpleOp op = simpleOpArgs op $ return () +simpleOp op = simpleOpArgs op $ pure () simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool simpleOpArgs op args = do @@ -137,7 +137,7 @@ simpleOpArgs op args = do err runOp :: WorkerOp -> MonadStore () -runOp op = runOpArgs op $ return () +runOp op = runOpArgs op $ pure () runOpArgs :: WorkerOp -> Put -> MonadStore () runOpArgs op args = @@ -179,7 +179,7 @@ runStoreOpts sockPath storeRootDir code = do 0 Network.Socket.connect soc (SockAddrUnix path) - return StoreConfig + pure StoreConfig { storeSocket = soc , storeDir = storeRootDir } diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs index 72aa223..66b6d22 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -36,7 +36,7 @@ genericIncremental :: (MonadIO m) => m (Maybe ByteString) -> Get a -> m a genericIncremental getsome parser = go decoder where decoder = runGetIncremental parser - go (Done _leftover _consumed x ) = return x + go (Done _leftover _consumed x ) = pure x go (Partial k ) = do chunk <- getsome go (k chunk) @@ -76,14 +76,14 @@ sockGetPath = do pth <- getSocketIncremental (getPath sd) either throwError - return + pure pth sockGetPathMay :: MonadStore (Maybe StorePath) sockGetPathMay = do sd <- getStoreDir pth <- getSocketIncremental (getPath sd) - return $ + pure $ either (const Nothing) Just diff --git a/hnix-store-remote/tests/NixDaemon.hs b/hnix-store-remote/tests/NixDaemon.hs index bdcdae3..8824ecd 100644 --- a/hnix-store-remote/tests/NixDaemon.hs +++ b/hnix-store-remote/tests/NixDaemon.hs @@ -48,7 +48,7 @@ createProcessEnv fp proc args = do { P.cwd = Just $ fp , P.env = Just $ mockedEnv mPath fp } - return ph + pure ph mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)] mockedEnv mEnvPath fp = @@ -66,7 +66,7 @@ waitSocket fp x = do ex <- doesFileExist fp bool (threadDelay 100000 >> waitSocket fp (x - 1)) - (return ()) + (pure ()) ex writeConf :: FilePath -> IO () @@ -98,7 +98,7 @@ startDaemon fp = do writeConf (fp "etc" "nix.conf") p <- createProcessEnv fp "nix-daemon" [] waitSocket sockFp 30 - return (p, runStoreOpts sockFp (fp "store")) + pure (p, runStoreOpts sockFp (fp "store")) where sockFp = fp "var/nix/daemon-socket/socket" @@ -142,7 +142,7 @@ it -> (a -> Bool) -> Hspec.SpecWith (m () -> IO (a, b)) it name action check = - Hspec.it name $ \run -> (run (action >> return ())) `checks` check + Hspec.it name $ \run -> (run (action >> pure ())) `checks` check itRights :: (Show a, Show b, Show c, Monad m) @@ -168,7 +168,7 @@ dummy :: MonadStore StorePath dummy = do let Right n = makeStorePathName "dummy" res <- addToStore @'SHA256 n "dummy" False (pure True) False - return res + pure res invalidPath :: StorePath invalidPath = @@ -203,7 +203,7 @@ spec_protocol = Hspec.around withNixDaemon $ verifyStore True True `shouldReturn` False context "addTextToStore" $ - itRights "adds text to store" $ withPath $ const return () + itRights "adds text to store" $ withPath $ const pure () context "isValidPathUncached" $ do itRights "validates path" $ withPath $ \path -> do