codex 0.3.0.10 → 0.4.0.0

raw patch · 5 files changed

+107/−66 lines, 5 filesdep ~codexdep ~processdep ~yamlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: codex, process, yaml

API changes (from Hackage documentation)

Files

• codex.cabal +6/−5
• codex/Main.hs +29/−17
• src/Codex.hs +20/−19
• src/Codex/Internal.hs +18/−8
• src/Codex/Project.hs +34/−17

@@ -1,11 +1,11 @@ name:                codex-version:             0.3.0.10+version:             0.4.0.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,-  it can then use this cache to generate `tags` files aggregating the sources of all the dependencies of your cabal projects.+  it can then use this cache to generate `tags` files aggregating the sources of all the dependencies of your cabal/stack projects.   .-  You basically do `codex update` in your cabal project directory and you'll get a file+  You basically do `codex update` in your project directory and you'll get a file   (`codex.tags` by default, or `TAGS` when using emacs format) that you can use in your   favorite text editor.   .@@ -62,6 +62,7 @@     Main.Config.Codex0     Main.Config.Codex1     Main.Config.Codex2+    Paths_codex   build-depends:       base     , Cabal@@ -71,12 +72,12 @@     , filepath     , hackage-db     , MissingH-    , yaml     , monad-loops         >= 0.4.2      && < 0.5     , network             >= 2.6        && < 2.7+    , process     , wreq     , yaml                -    , codex               == 0.3.0.10+    , codex               == 0.4.0.0  source-repository head   type:     git

@@ -18,11 +18,13 @@ import Paths_codex (version) import System.Directory import System.Environment-import System.FilePath import System.Exit+import System.FilePath+import System.Process (shell, readCreateProcessWithExitCode)  import Codex import Codex.Project+import Codex.Internal (Builder(..), hackagePathOf, readStackPath) import Main.Config  -- TODO Add 'cache dump' to dump all tags in stdout (usecase: pipe to grep)@@ -62,9 +64,9 @@ writeCacheHash :: Codex -> String -> IO () writeCacheHash cx = writeFile $ hashFile cx -update :: Codex -> Bool -> IO ()-update cx force = do-  (project, dependencies, workspaceProjects') <- resolveCurrentProjectDependencies $ hackagePath cx </> "00-index.tar"+update :: Bool -> Codex -> Builder -> IO ()+update force cx bldr = do+  (project, dependencies, workspaceProjects') <- resolveCurrentProjectDependencies bldr $ hackagePath cx </> "00-index.tar"   projectHash <- computeCurrentProjectHash cx    shouldUpdate <-@@ -80,17 +82,18 @@     putStrLn $ concat ["Updating ", display project]     results <- withSession $ \s -> traverse (retrying 3 . runEitherT . getTags s) dependencies     _       <- traverse print . concat $ lefts results-    res     <- runEitherT $ assembly cx dependencies projectHash workspaceProjects tagsFile+    res     <- runEitherT $ assembly bldr cx dependencies projectHash workspaceProjects tagsFile     either print (const $ return ()) res   else     putStrLn "Nothing to update."   where     tagsFile = tagsFileName cx-    getTags s i = status cx i >>= \x -> case x of+    hp = hackagePathOf bldr cx+    getTags s i = status hp i >>= \x -> case x of       Source Tagged   -> return ()-      Source Untagged -> tags cx i >> getTags s i-      Archive         -> extract cx i >> getTags s i-      Remote          -> fetch s cx i >> getTags s i+      Source Untagged -> tags bldr cx i >> getTags s i+      Archive         -> extract hp i >> getTags s i+      Remote          -> fetch s hp i >> getTags s i  help :: IO () help = putStrLn $@@ -114,8 +117,8 @@   args  <- getArgs   run cx args where     run cx ["cache", "clean"] = cleanCache cx-    run cx ["update"]             = withConfig cx (\x -> update x False)-    run cx ["update", "--force"]  = withConfig cx (\x -> update x True)+    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 }     run cx ["set", "tagger", "hasktags"]  = encodeConfig $ cx { tagsCmd = taggerCmd Hasktags }     run cx ["set", "format", "emacs"]     = encodeConfig $ cx { tagsCmd = taggerCmd HasktagsEmacs, tagsFileHeader = False, tagsFileSorted = False, tagsFileName = "TAGS" }@@ -126,20 +129,29 @@     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+    withConfig cx' f = 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+                            globalPath <- readStackPath "global-stack-root"+                            return (Stack, cx' { hackagePath = globalPath </> "indices" </> "Hackage" })+                          _           ->+                            return (Cabal, cx')+                      else return (Cabal, cx')         cacheHash' <- readCacheHash cx         case cacheHash' of           Just cacheHash ->-            when (cacheHash /= currentHash) $ do+            when (cacheHash /= codexHash cx) $ do               putStrLn "codex: configuration has been updated, cleaning cache ..."               cleanCache cx           Nothing -> return ()-        res <- f cx-        writeCacheHash cx currentHash-        return res where-          currentHash = codexHash cx+        res <- f cx bldr+        writeCacheHash cx $ codexHash cx+        return res      fail' msg = do       putStrLn $ msg

@@ -113,23 +113,23 @@   where     file = tagsFileName cx -status :: Codex -> PackageIdentifier -> Action Status-status cx i = do-  sourcesExist <- tryIO . doesDirectoryExist $ packageSources cx i-  archiveExist <- tryIO . doesFileExist $ packageArchive cx i+status :: FilePath -> PackageIdentifier -> Action Status+status root i = do+  sourcesExist <- tryIO . doesDirectoryExist $ packageSources root i+  archiveExist <- tryIO . doesFileExist $ packageArchive root i   case (sourcesExist, archiveExist) of-    (True, _) -> fmap (Source . fromBool) (liftIO . doesFileExist $ packageTags cx i)+    (True, _) -> fmap (Source . fromBool) (liftIO . doesFileExist $ packageTags root i)     (_, True) -> return Archive     (_, _)    -> return Remote -fetch :: WS.Session -> Codex -> PackageIdentifier -> Action FilePath-fetch s cx i = do+fetch :: WS.Session -> FilePath -> PackageIdentifier -> Action FilePath+fetch s root i = do   bs <- tryIO $ do-    createDirectoryIfMissing True (packagePath cx i)+    createDirectoryIfMissing True (packagePath root i)     openLazyURI s url   either left write bs where     write bs = fmap (const archivePath) $ tryIO $ BS.writeFile archivePath bs-    archivePath = packageArchive cx i+    archivePath = packageArchive root i     url = packageUrl i  openLazyURI :: WS.Session -> String -> IO (Either String BS.ByteString)@@ -137,18 +137,19 @@   showHttpEx :: HttpException -> String   showHttpEx = show -extract :: Codex -> PackageIdentifier -> Action FilePath-extract cx i = fmap (const path) . tryIO $ read' path (packageArchive cx i) where+extract :: FilePath -> PackageIdentifier -> Action FilePath+extract root i = fmap (const path) . tryIO $ read' path (packageArchive root i) where   read' dir tar = Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar-  path = packagePath cx i+  path = packagePath root i -tags :: Codex -> PackageIdentifier -> Action FilePath-tags cx i = taggerCmdRun cx sources tags' where-    sources = packageSources cx i-    tags' = packageTags cx i+tags :: Builder -> Codex -> PackageIdentifier -> Action FilePath+tags bldr cx i = taggerCmdRun cx sources tags' where+    sources = packageSources hp i+    tags' = packageTags hp i+    hp = hackagePathOf bldr cx -assembly :: Codex -> [PackageIdentifier] -> String -> [WorkspaceProject] -> FilePath -> Action FilePath-assembly cx dependencies projectHash workspaceProjects o = do+assembly :: Builder -> Codex -> [PackageIdentifier] -> String -> [WorkspaceProject] -> FilePath -> Action FilePath+assembly bldr cx dependencies projectHash workspaceProjects o = do   xs <- join . maybeToList <$> projects workspaceProjects   tryIO $ mergeTags (fmap tags' dependencies ++ xs) o   return o where@@ -164,7 +165,7 @@       let xs = concat $ fmap TextL.lines contents       let ys = if sorted then (Set.toList . Set.fromList) xs else xs       TLIO.writeFile o' $ TextL.unlines (concat [headers, ys])-    tags' = packageTags cx+    tags' = packageTags $ hackagePathOf bldr cx     headers = if tagsFileHeader cx then fmap TextL.pack [headerFormat, headerSorted, headerHash] else []     headerFormat = "!_TAG_FILE_FORMAT\t2"     headerSorted = concat ["!_TAG_FILE_SORTED\t", if sorted then "1" else "0"]

@@ -8,12 +8,15 @@ import Distribution.Text import GHC.Generics import System.FilePath+import System.Process (shell, readCreateProcess)  import qualified Data.List as L  defaultTagsFileName :: FilePath defaultTagsFileName = "codex.tags" +data Builder = Cabal | Stack+ data Codex = Codex   { currentProjectIncluded :: Bool   , hackagePath :: FilePath@@ -27,22 +30,26 @@ instance ToJSON Codex instance FromJSON Codex -packagePath :: Codex -> PackageIdentifier -> FilePath-packagePath cx i = hackagePath cx </> relativePath i where+hackagePathOf :: Builder -> Codex -> FilePath+hackagePathOf Cabal cx = hackagePath cx+hackagePathOf Stack cx = hackagePath cx </> "packages"++packagePath :: FilePath -> PackageIdentifier -> FilePath+packagePath root i = root </> relativePath i where   relativePath _ = name </> version where     name = display $ pkgName i     version = display $ pkgVersion i -packageArchive :: Codex -> PackageIdentifier -> FilePath-packageArchive cx i = packagePath cx i </> name where+packageArchive :: FilePath -> PackageIdentifier -> FilePath+packageArchive root i = packagePath root i </> name where   name = concat [display $ pkgName i, "-", display $ pkgVersion i, ".tar.gz"] -packageSources :: Codex -> PackageIdentifier -> FilePath-packageSources cx i = packagePath cx i </> name where+packageSources :: FilePath -> PackageIdentifier -> FilePath+packageSources root i = packagePath root i </> name where   name = concat [display $ pkgName i, "-", display $ pkgVersion i] -packageTags :: Codex -> PackageIdentifier -> FilePath-packageTags cx i = packagePath cx i </> "tags"+packageTags :: FilePath -> PackageIdentifier -> FilePath+packageTags root i = packagePath root i </> "tags"  packageUrl :: PackageIdentifier -> String packageUrl i = concat ["http://hackage.haskell.org/package/", path] where@@ -56,3 +63,6 @@     else Nothing  where   trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace++readStackPath :: String -> IO String+readStackPath id' = init <$> readCreateProcess (shell ("stack path --" ++ id')) ""

@@ -17,8 +17,11 @@ import Distribution.PackageDescription.Parse import Distribution.Sandbox.Utils (findSandbox) import Distribution.Simple.Configure+import Distribution.Simple.Compiler import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex+import Distribution.Simple.Program (defaultProgramConfiguration)+import Distribution.Simple.Setup import Distribution.Verbosity import Distribution.Version import System.Directory@@ -27,6 +30,8 @@ import qualified Data.List as List import qualified Data.Map as Map +import Codex.Internal (Builder(..), readStackPath)+ newtype Workspace = Workspace [WorkspaceProject]   deriving (Eq, Show) @@ -52,16 +57,16 @@   files     <- filterM (doesFileExist . (</>) root) contents   traverse (readPackageDescription silent) $ fmap (\x -> root </> x) $ List.find (List.isSuffixOf ".cabal") files -resolveCurrentProjectDependencies :: FilePath -> IO ProjectDependencies-resolveCurrentProjectDependencies hackagePath = do+resolveCurrentProjectDependencies :: Builder -> FilePath -> IO ProjectDependencies+resolveCurrentProjectDependencies bldr hackagePath = do   ws <- getWorkspace ".."-  resolveProjectDependencies ws hackagePath "."+  resolveProjectDependencies bldr ws hackagePath "."  -- TODO Optimize-resolveProjectDependencies :: Workspace -> FilePath -> FilePath -> IO ProjectDependencies-resolveProjectDependencies ws hackagePath root = do+resolveProjectDependencies :: Builder -> Workspace -> FilePath -> FilePath -> IO ProjectDependencies+resolveProjectDependencies bldr ws hackagePath root = do   pd <- maybe (error "No cabal file found.") id <$> findPackageDescription root-  xs <- resolvePackageDependencies hackagePath root pd+  xs <- resolvePackageDependencies bldr hackagePath root pd   ys <- resolveSandboxDependencies root   let zs   = resolveWorkspaceDependencies ws pd   let wsds = List.filter (shouldOverride xs) $ List.nubBy (on (==) prjId) $ concat [ys, zs]@@ -71,16 +76,28 @@       maybe True (\y -> pkgVersion x >= pkgVersion y) $ List.find (\y -> pkgName x == pkgName y) xs     prjId = pkgName . workspaceProjectIdentifier -resolveInstalledDependencies :: FilePath -> IO (Either SomeException [PackageIdentifier])-resolveInstalledDependencies root = try $ do-  lbi <- getPersistBuildConfig distPref+resolveInstalledDependencies :: Builder -> FilePath -> GenericPackageDescription -> IO (Either SomeException [PackageIdentifier])+resolveInstalledDependencies bldr root pd = try $ do+  lbi <- case bldr of+    Cabal -> withCabal+    Stack -> withStack   let ipkgs = installedPkgs lbi       clbis = snd <$> allComponentsInBuildOrder lbi       pkgs  = componentPackageDeps =<< clbis       ys = (maybeToList . lookupInstalledPackageId ipkgs) =<< fmap fst pkgs       xs = fmap sourcePackageId $ ys   return xs where-    distPref = root </> "dist"+    withCabal = getPersistBuildConfig $ root </> "dist"+    withStack = do+      cfs <- getConfigFlags+      configure (pd, emptyHookedBuildInfo) cfs+        where+          getConfigFlags = do+            snapshotDb  <- readStackPath "snapshot-pkg-db"+            localDb     <- readStackPath "local-pkg-db"+            return $ (defaultConfigFlags defaultProgramConfiguration) {+              configPackageDBs = Just . SpecificPackageDB <$> [snapshotDb, localDb]+            }  resolveHackageDependencies :: Hackage -> GenericPackageDescription -> [GenericPackageDescription] resolveHackageDependencies db pd = maybeToList . resolveDependency db =<< allDependencies pd where@@ -89,17 +106,17 @@     latest <- List.find (\x -> withinRange x versionRange) $ List.reverse $ List.sort $ Map.keys pdsByVersion     Map.lookup latest pdsByVersion -resolvePackageDependencies :: FilePath -> FilePath -> GenericPackageDescription -> IO [PackageIdentifier]-resolvePackageDependencies hackagePath root pd = do-  xs <- either (fallback pd) return =<< resolveInstalledDependencies root+resolvePackageDependencies :: Builder -> FilePath -> FilePath -> GenericPackageDescription -> IO [PackageIdentifier]+resolvePackageDependencies bldr hackagePath root pd = do+  xs <- either fallback return =<< resolveInstalledDependencies bldr root pd   return xs where-    fallback pd' e = do+    fallback e = do       putStrLn $ concat ["cabal: ", show e]       putStrLn "codex: *warning* falling back on dependency resolution using hackage"-      resolveWithHackage pd'-    resolveWithHackage pd' = do+      resolveWithHackage+    resolveWithHackage = do       db <- readHackage' hackagePath-      return $ identifier <$> resolveHackageDependencies db pd'+      return $ identifier <$> resolveHackageDependencies db pd  resolveSandboxDependencies :: FilePath -> IO [WorkspaceProject] resolveSandboxDependencies root =