diff --git a/codex.cabal b/codex.cabal --- a/codex.cabal +++ b/codex.cabal @@ -1,5 +1,5 @@ name: codex -version: 0.0.2 +version: 0.0.2.1 synopsis: A ctags file generator for cabal project dependencies. description: This tool download and cache the source code of packages in your local hackage, diff --git a/src/Codex.hs b/src/Codex.hs --- a/src/Codex.hs +++ b/src/Codex.hs @@ -72,7 +72,7 @@ content <- tryIO $ TLIO.readFile file let hash = TextL.toStrict . TextL.drop 17 . head . drop 2 $ TextL.lines content return $ hash /= (Text.pack $ dependenciesHash is) - else + else return True status :: Codex -> PackageIdentifier -> Action Status @@ -86,7 +86,7 @@ fetch :: Codex -> PackageIdentifier -> Action FilePath fetch cx i = do - bs <- tryIO $ do + bs <- tryIO $ do createDirectoryIfMissing True (packagePath cx i) openLazyURI url either left write bs where @@ -107,15 +107,15 @@ assembly :: Codex -> [PackageIdentifier] -> [WorkspaceProject] -> FilePath -> Action FilePath assembly cx dependencies workspaceProjects o = do xs <- fmap (join . maybeToList) $ projects workspaceProjects - tryIO $ mergeTags ((fmap tags dependencies) ++ xs) o + tryIO $ mergeTags ((fmap tags dependencies) ++ xs) o return o where projects [] = return Nothing projects xs = do - tmp <- liftIO $ getTemporaryDirectory + tmp <- liftIO $ getTemporaryDirectory ys <- traverse (tags tmp) xs return $ Just ys where tags tmp (WorkspaceProject identifier sources) = taggerCmdRun cx sources tags where - tags = joinPath [tmp, concat [display identifier, ".tags"]] + tags = tmp concat [display identifier, ".tags"] mergeTags files o = do contents <- traverse TLIO.readFile files let xs = List.sort . concat $ fmap TextL.lines contents diff --git a/src/Codex/Internal.hs b/src/Codex/Internal.hs --- a/src/Codex/Internal.hs +++ b/src/Codex/Internal.hs @@ -9,21 +9,21 @@ data Codex = Codex { tagsCmd :: String, hackagePath :: FilePath } packagePath :: Codex -> PackageIdentifier -> FilePath -packagePath cx i = joinPath [hackagePath cx, relativePath i] where - relativePath i = joinPath [name, version] where +packagePath cx i = hackagePath cx relativePath i where + relativePath i = name version where name = display $ pkgName i version = display $ pkgVersion i packageArchive :: Codex -> PackageIdentifier -> FilePath -packageArchive cx i = joinPath [packagePath cx i, name] where +packageArchive cx i = packagePath cx i name where name = concat [display $ pkgName i, "-", display $ pkgVersion i, ".tar.gz"] packageSources :: Codex -> PackageIdentifier -> FilePath -packageSources cx i = joinPath [packagePath cx i, name] where +packageSources cx i = packagePath cx i name where name = concat [display $ pkgName i, "-", display $ pkgVersion i] packageTags :: Codex -> PackageIdentifier -> FilePath -packageTags cx i = joinPath [packagePath cx i, "tags"] +packageTags cx i = packagePath cx i "tags" packageUrl :: PackageIdentifier -> String packageUrl i = concat ["http://hackage.haskell.org/package/", path] where diff --git a/src/Codex/Project.hs b/src/Codex/Project.hs --- a/src/Codex/Project.hs +++ b/src/Codex/Project.hs @@ -36,15 +36,15 @@ allDependencies :: GenericPackageDescription -> [Dependency] allDependencies pd = List.filter (not . isCurrent) $ concat [lds, eds, tds] where - lds = condTreeConstraints =<< (maybeToList $ condLibrary pd) - eds = (condTreeConstraints . snd) =<< condExecutables pd - tds = (condTreeConstraints . snd) =<< condTestSuites pd + lds = condTreeConstraints =<< (maybeToList $ condLibrary pd) + eds = (condTreeConstraints . snd) =<< condExecutables pd + tds = (condTreeConstraints . snd) =<< condTestSuites pd isCurrent (Dependency n _) = n == (pkgName $ identifier pd) findPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription) findPackageDescription root = do files <- getDirectoryContents root - traverse (readPackageDescription silent) $ fmap (\x -> joinPath [root, x]) $ List.find (endswith ".cabal") files + traverse (readPackageDescription silent) $ fmap (\x -> root x) $ List.find (endswith ".cabal") files resolveCurrentProjectDependencies :: IO ProjectDependencies resolveCurrentProjectDependencies = do @@ -59,7 +59,7 @@ let wsds = List.filter (shouldOverride xs) $ resolveWorkspaceDependencies ws pd let pjds = List.filter (\x -> List.notElem (pkgName x) $ fmap (\(WorkspaceProject x _) -> pkgName x) wsds) xs return (identifier pd, pjds, wsds) where - shouldOverride xs (WorkspaceProject x _) = + shouldOverride xs (WorkspaceProject x _) = maybe True (\y -> pkgVersion x >= pkgVersion y) $ List.find (\y -> pkgName x == pkgName y) xs resolveProjectDependencies :: FilePath -> GenericPackageDescription -> IO [PackageIdentifier] @@ -83,7 +83,7 @@ pkgs = componentPackageDeps =<< clbis xs = fmap sourcePackageId $ (maybeToList . lookupInstalledPackageId ipkgs) =<< fmap fst pkgs return xs where - distPref = joinPath [root, "dist"] + distPref = root "dist" resolveHackageDependencies :: Hackage -> GenericPackageDescription -> [GenericPackageDescription] resolveHackageDependencies db pd = maybeToList . resolveDependency db =<< allDependencies pd where @@ -94,18 +94,21 @@ resolveWorkspaceDependencies :: Workspace -> GenericPackageDescription -> [WorkspaceProject] resolveWorkspaceDependencies (Workspace ws) pd = maybeToList . resolveDependency =<< allDependencies pd where - resolveDependency (Dependency name versionRange) = + resolveDependency (Dependency name versionRange) = List.find (\(WorkspaceProject (PackageIdentifier n v) _) -> n == name && withinRange v versionRange) ws getWorkspace :: FilePath -> IO Workspace getWorkspace _root = do root <- canonicalizePath _root - xs <- listDirectory root + xs <- listDirectory root ys <- traverse find xs return . Workspace $ ys >>= maybeToList where find path = do - pd <- findPackageDescription path - return $ fmap (\x -> WorkspaceProject (identifier x) path) pd + isDirectory <- doesDirectoryExist path + if isDirectory then do + pd <- findPackageDescription path + return $ fmap (\x -> WorkspaceProject (identifier x) path) pd + else return Nothing listDirectory fp = do - xs <- getDirectoryContents fp + xs <- getDirectoryContents fp return . fmap (fp ) $ filter (not . startswith ".") xs diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -84,7 +84,9 @@ , " cache clean Remove all `tags` file from the local hackage cache]" , " set tagger Update the `~/.codex` configuration file for the given tagger (hasktags|ctags)." , "" - , "By default `hasktags` will be used, and need to be in the `PATH`, the tagger command can be fully customized in `~/.codex`." ] + , "By default `hasktags` will be used, and need to be in the `PATH`, the tagger command can be fully customized in `~/.codex`." + , "" + , "Note: codex will browse the parent directory for cabal projects and use them as dependency over hackage when possible." ] main :: IO () main = do