codex 0.5.0.2 → 0.5.1.0
raw patch · 3 files changed
+71/−45 lines, 3 filesdep +ascii-progressdep ~basedep ~directorydep ~http-clientPVP ok
version bump matches the API change (PVP)
Dependencies added: ascii-progress
Dependency ranges changed: base, directory, http-client, wreq
API changes (from Hackage documentation)
+ Codex: newProgressBar' :: (MonadIO m, MonadIO m2, Integral estimate) => String -> estimate -> m (m2 ())
Files
- codex.cabal +8/−6
- codex/Main.hs +47/−37
- src/Codex.hs +16/−2
codex.cabal view
@@ -1,5 +1,5 @@ name: codex-version: 0.5.0.2+version: 0.5.1.0 synopsis: A ctags file generator for cabal project dependencies. description: This tool download and cache the source code of packages in your local hackage,@@ -30,16 +30,17 @@ Codex.Internal Distribution.Sandbox.Utils build-depends:- base >= 4.6.0.1 && < 5+ ascii-progress >= 0.3+ , base >= 4.6.0.1 && < 5 , bytestring >= 0.10.0.2 && < 0.11 , Cabal >= 1.18 && < 1.25 , cryptohash >= 0.11 && < 0.12 , containers >= 0.5.0.0 && < 0.6- , directory >= 1.2.0.1 && < 1.3+ , directory >= 1.2.0.1 && < 1.4 , either >= 4.3.0.1 && < 4.5 , filepath >= 1.3.0.1 && < 1.5 , hackage-db >= 1.22 && < 2- , http-client >= 0.4 && < 0.5+ , http-client >= 0.4 && < 0.6 , lens >= 4.6 && < 5 , machines >= 0.2 && < 0.7 , machines-directory >= 0.0.0.2 && < 0.3@@ -48,7 +49,7 @@ , text >= 1.1.1.3 && < 1.3 , transformers >= 0.3.0.0 && < 0.6 , yaml >= 0.8.8.3 && < 0.9- , wreq >= 0.3.0.1 && < 0.5+ , wreq >= 0.3.0.1 && < 0.6 , zlib >= 0.5.4.1 && < 0.7 executable codex@@ -64,7 +65,8 @@ Main.Config.Codex3 Paths_codex build-depends:- base+ ascii-progress+ , base , Cabal , bytestring , directory
codex/Main.hs view
@@ -17,6 +17,7 @@ import Network.Socket (withSocketsDo) import Network.Wreq.Session (withSession) import Paths_codex (version)+import System.Console.AsciiProgress (displayConsoleRegions) import System.Directory import System.Environment import System.Exit@@ -42,18 +43,23 @@ hashFile :: Codex -> FilePath hashFile cx = hackagePath cx </> "codex.hash" -cleanCache :: Codex -> IO ()-cleanCache cx = do+cleanCache :: (Builder, Codex) -> IO ()+cleanCache (bldr, cx) = do -- TODO Delete hash file! xs <- listDirectory hp- ys <- fmap rights $ traverse (safe . listDirectory) xs- _ <- traverse (safe . removeFile) . fmap (</> "tags") $ concat ys- return () where+ ys <- builderOp bldr =<< traverseDirectories xs+ _ <- removeTagFiles $ concat ys+ return ()+ where hp = hackagePath cx safe = (try :: IO a -> IO (Either SomeException a)) listDirectory fp = do xs <- getDirectoryContents fp return . fmap (fp </>) $ filter (not . startswith ".") xs+ removeTagFiles = traverse (safe . removeFile) . fmap (</> "tags")+ traverseDirectories = fmap rights . traverse (safe . listDirectory)+ builderOp (Stack _) = traverseDirectories . concat+ builderOp Cabal = return readCacheHash :: Codex -> IO (Maybe String) readCacheHash cx = do@@ -66,7 +72,7 @@ writeCacheHash cx = writeFile $ hashFile cx update :: Bool -> Codex -> Builder -> IO ()-update force cx bldr = do+update force cx bldr = displayConsoleRegions $ do (project, dependencies, workspaceProjects') <- resolveCurrentProjectDependencies bldr $ hackagePath cx </> "00-index.tar" projectHash <- computeCurrentProjectHash cx @@ -81,7 +87,9 @@ fileExist <- doesFileExist tagsFile when fileExist $ removeFile tagsFile putStrLn $ concat ["Updating ", display project]- results <- withSession $ \s -> traverse (retrying 3 . runEitherT . getTags s) dependencies+ results <- withSession $ \s -> do+ tick' <- newProgressBar' "Loading tags" (length dependencies)+ traverse (retrying 3 . runEitherT . getTags tick' s) dependencies _ <- traverse print . concat $ lefts results res <- runEitherT $ assembly bldr cx dependencies projectHash workspaceProjects tagsFile either print (const $ return ()) res@@ -90,11 +98,11 @@ where tagsFile = tagsFileName cx hp = hackagePathOf bldr cx- getTags s i = status hp i >>= \x -> case x of- Source Tagged -> return ()- Source Untagged -> tags bldr cx i >> getTags s i- Archive -> extract hp i >> getTags s i- Remote -> liftIO $ eitherT ignore return $ fetch s hp i >> getTags s i+ getTags tick' s i = status hp i >>= \x -> case x of+ Source Tagged -> tick' >> return ()+ Source Untagged -> tags bldr cx i >> tick' >> getTags tick' s i+ Archive -> extract hp i >> tick' >> getTags tick' s i+ Remote -> liftIO $ eitherT ignore return $ fetch s hp i >> tick' >> getTags tick' s i where ignore msg = do putStrLn $ concat ["codex: *warning* unable to fetch an archive for ", display i]@@ -122,7 +130,7 @@ cx <- loadConfig args <- getArgs run cx args where- run cx ["cache", "clean"] = cleanCache cx+ run cx ["cache", "clean"] = toBuilderConfig cx >>= cleanCache run cx ["update"] = withConfig cx (update False) run cx ["update", "--force"] = withConfig cx (update True) run cx ["set", "tagger", "ctags"] = encodeConfig $ cx { tagsCmd = taggerCmd Ctags }@@ -135,35 +143,37 @@ run _ [] = help run _ args = fail' $ concat ["codex: '", intercalate " " args,"' is not a codex command. See 'codex --help'."] - withConfig cx' f = checkConfig cx' >>= \state -> case state of+ toBuilderConfig cx' = checkConfig cx' >>= \state -> case state of TaggerNotFound -> fail' $ "codex: tagger not found." Ready -> do stackFileExists <- doesFileExist $ "." </> "stack.yaml"- (bldr, cx) <- if stackFileExists then do- (ec, _, _) <- readCreateProcessWithExitCode (shell "which stack") ""- case ec of- ExitSuccess -> do- let opts = stackOpts cx'- globalPath <- readStackPath opts "stack-root"- binPath <- readStackPath opts "bin-path"- path <- getEnv "PATH"- setEnv "PATH" $ concat [path, ":", binPath]- return (Stack opts, cx' { hackagePath = globalPath </> "indices" </> "Hackage" })- _ ->- return (Cabal, cx')- else return (Cabal, cx')- cacheHash' <- readCacheHash cx- case cacheHash' of- Just cacheHash ->+ if stackFileExists then do+ (ec, _, _) <- readCreateProcessWithExitCode (shell "which stack") ""+ case ec of+ ExitSuccess -> do+ let opts = stackOpts cx'+ globalPath <- readStackPath opts "stack-root"+ binPath <- readStackPath opts "bin-path"+ path <- getEnv "PATH"+ setEnv "PATH" $ concat [path, ":", binPath]+ return (Stack opts, cx' { hackagePath = globalPath </> "indices" </> "Hackage" })+ _ ->+ return (Cabal, cx')+ else return (Cabal, cx')++ withConfig cx' f = do+ (bldr, cx) <- toBuilderConfig cx'+ cacheHash' <- readCacheHash cx+ case cacheHash' of+ Just cacheHash -> when (cacheHash /= codexHash cx) $ do- putStrLn "codex: configuration has been updated, cleaning cache ..."- cleanCache cx- Nothing -> return ()- res <- f cx bldr- writeCacheHash cx $ codexHash cx- return res+ putStrLn "codex: configuration has been updated, cleaning cache ..."+ cleanCache (bldr, cx)+ Nothing -> return ()+ res <- f cx bldr+ writeCacheHash cx $ codexHash cx+ return res fail' msg = do putStrLn $ msg exitWith (ExitFailure 1)-
src/Codex.hs view
@@ -19,6 +19,7 @@ import Distribution.Text import Distribution.Verbosity import Network.HTTP.Client (HttpException)+import System.Console.AsciiProgress (def, newProgressBar, Options(..), tick) import System.Directory import System.Directory.Machine (files, directoryWalk) import System.FilePath@@ -156,14 +157,16 @@ return o where projects [] = return Nothing projects xs = do+ tick' <- newProgressBar' "Running tagger" (length xs) tmp <- liftIO getTemporaryDirectory- ys <- traverse (tags'' tmp) xs+ ys <- traverse (\wsp -> tags'' tmp wsp <* tick') xs return $ Just ys where tags'' tmp (WorkspaceProject id' sources) = taggerCmdRun cx sources tags''' where tags''' = tmp </> concat [display id', ".tags"] mergeTags files' o' = do files'' <- filterM doesFileExist files'- contents <- traverse TLIO.readFile files''+ tick' <- newProgressBar' "Merging tags" (length files'')+ contents <- traverse (\f -> TLIO.readFile f <* tick') files'' case files' \\ files'' of [] -> return () xs -> do@@ -179,3 +182,14 @@ headerSorted = concat ["!_TAG_FILE_SORTED\t", if sorted then "1" else "0"] headerHash = concat ["!_TAG_FILE_CODEX\t", tagsFileHash cx dependencies projectHash] sorted = tagsFileSorted cx+++newProgressBar' :: (MonadIO m, MonadIO m2, Integral estimate) => String -> estimate -> m (m2 ())+newProgressBar' label est = liftIO $ do+ bar <- newProgressBar options+ return (liftIO (tick bar))+ where+ options = def {+ pgTotal = fromIntegral est+ , pgFormat = label ++ " :percent [:bar] :current/:total (for :elapsed, :eta remaining)"+ }