diff --git a/codex.cabal b/codex.cabal --- a/codex.cabal +++ b/codex.cabal @@ -1,5 +1,5 @@ name: codex -version: 0.2.1.8 +version: 0.2.1.10 synopsis: A ctags file generator for cabal project dependencies. description: This tool download and cache the source code of packages in your local hackage, @@ -23,7 +23,7 @@ library default-language: Haskell2010 hs-source-dirs: src - ghc-options: -fwarn-incomplete-patterns + ghc-options: -Wall exposed-modules: Codex Codex.Project @@ -41,20 +41,21 @@ , either >= 4.3.0.1 && < 4.4 , filepath >= 1.3.0.1 && < 1.5 , hackage-db >= 1.8 && < 2 - , machines >= 0.2 && < 0.5 + , machines >= 0.2 && < 0.6 , machines-directory >= 0.0.0.2 && < 0.3 , MissingH >= 1.2.1.0 && < 1.4 , process >= 1.1.0.2 && < 1.3 , tar >= 0.4.0.1 && < 0.5 , text >= 1.1.1.3 && < 1.3 , transformers >= 0.3.0.0 && < 0.5 + , yaml >= 0.8.8.3 && < 0.9 , zlib >= 0.5.4.1 && < 0.6 executable codex default-language: Haskell2010 hs-source-dirs: codex main-is: Main.hs - ghc-options: -threaded -fwarn-incomplete-patterns + ghc-options: -threaded -Wall other-modules: Main.Config Main.Config.Codex0 @@ -69,9 +70,9 @@ , filepath , hackage-db , MissingH + , yaml , monad-loops >= 0.4.2 && < 0.5 - , yaml >= 0.8.8.3 && < 0.9 - , codex == 0.2.1.8 + , codex == 0.2.1.10 source-repository head type: git diff --git a/codex/Main.hs b/codex/Main.hs --- a/codex/Main.hs +++ b/codex/Main.hs @@ -3,10 +3,8 @@ import Control.Monad import Control.Monad.Trans.Either hiding (left, right) import Data.Either -import Data.Functor import Data.List import Data.String.Utils -import Data.Traversable (traverse) import Distribution.Text import Paths_codex (version) import System.Directory @@ -24,9 +22,9 @@ retrying :: Int -> IO (Either a b) -> IO (Either [a] b) retrying n x = retrying' n $ fmap (left (:[])) x where - retrying' 0 x = x - retrying' n x = retrying' (n - 1) $ x >>= \res -> case res of - Left ls -> fmap (left (++ ls)) x + retrying' 0 x' = x' + retrying' n' x' = retrying' (n' - 1) $ x' >>= \res -> case res of + Left ls -> fmap (left (++ ls)) x' Right r -> return $ Right r hashFile :: Codex -> FilePath @@ -37,7 +35,7 @@ -- TODO Delete hash file! xs <- listDirectory hp ys <- fmap rights $ traverse (safe . listDirectory) xs - zs <- traverse (safe . removeFile) . fmap ( "tags") $ concat ys + _ <- traverse (safe . removeFile) . fmap ( "tags") $ concat ys return () where hp = hackagePath cx safe = (try :: IO a -> IO (Either SomeException a)) @@ -72,8 +70,8 @@ when fileExist $ removeFile tagsFile putStrLn $ concat ["Updating ", display project] results <- traverse (retrying 3 . runEitherT . getTags) dependencies - traverse print . concat $ lefts results - res <- runEitherT $ assembly cx dependencies projectHash workspaceProjects tagsFile + _ <- traverse print . concat $ lefts results + res <- runEitherT $ assembly cx dependencies projectHash workspaceProjects tagsFile either print (const $ return ()) res else putStrLn "Nothing to update." @@ -114,13 +112,13 @@ run cx ["set", "format", "emacs"] = encodeConfig $ cx { tagsCmd = taggerCmd HasktagsEmacs, tagsFileHeader = False, tagsFileSorted = False, tagsFileName = "TAGS" } run cx ["set", "format", "sublime"] = encodeConfig $ cx { tagsCmd = taggerCmd HasktagsExtended, tagsFileHeader = True, tagsFileSorted = True } run cx ["set", "format", "vim"] = encodeConfig $ cx { tagsFileHeader = True, tagsFileSorted = True } - run cx ["--version"] = putStrLn $ concat ["codex: ", display version] - run cx ["--help"] = help - run cx [] = help - run cx args = fail $ concat ["codex: '", intercalate " " args,"' is not a codex command. See 'codex --help'."] + run _ ["--version"] = putStrLn $ concat ["codex: ", display version] + run _ ["--help"] = help + 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 - TaggerNotFound -> fail $ "codex: tagger not found." + TaggerNotFound -> fail' $ "codex: tagger not found." Ready -> do cacheHash' <- readCacheHash cx case cacheHash' of @@ -134,7 +132,7 @@ return res where currentHash = codexHash cx - fail msg = do + fail' msg = do putStrLn $ msg exitWith (ExitFailure 1) diff --git a/codex/Main/Config.hs b/codex/Main/Config.hs --- a/codex/Main/Config.hs +++ b/codex/Main/Config.hs @@ -1,10 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} module Main.Config where import Data.Yaml -import GHC.Generics - import System.Directory import System.FilePath @@ -17,10 +13,6 @@ data ConfigState = Ready | TaggerNotFound -deriving instance Generic Codex -instance ToJSON Codex -instance FromJSON Codex - getConfigPath :: IO FilePath getConfigPath = do homedir <- getHomeDirectory @@ -30,7 +22,7 @@ checkConfig cx = do taggerExe <- findExecutable tagger return $ case taggerExe of - Just path -> Ready + Just _ -> Ready _ -> TaggerNotFound where tagger = head $ words (tagsCmd cx) @@ -60,10 +52,11 @@ cfg1 <- config1 path case cfg1 of Nothing -> config0 path - cfg1 -> return cfg1 - cfg2 -> return cfg2 - cfg -> return cfg + cfg1' -> return cfg1' + cfg2' -> return cfg2' + cfg' -> return cfg' where + warn :: IO () -> IO () warn migrateWarn = do putStrLn "codex: *warning* your configuration has been migrated automatically!\n" migrateWarn @@ -77,9 +70,9 @@ rawCfg <- configOf path let cfg = fmap migrate rawCfg case cfg of - Nothing -> return () - Just cfg -> do - encodeConfig cfg + Nothing -> return () + Just cfg' -> do + encodeConfig cfg' warn migrateWarn return cfg diff --git a/src/Codex.hs b/src/Codex.hs --- a/src/Codex.hs +++ b/src/Codex.hs @@ -1,17 +1,14 @@ module Codex (Codex(..), defaultTagsFileName, Verbosity, module Codex) where import Control.Exception (try, SomeException) -import Control.Applicative ((<$>)) import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Either import Data.Hash.MD5 import Data.Machine import Data.Maybe -import Data.Traversable (traverse) import Data.String.Utils hiding (join) import Distribution.Package -import Distribution.PackageDescription import Distribution.Text import Distribution.Verbosity import Network.Curl.DownloadLazy @@ -55,10 +52,10 @@ taggerCmd HasktagsExtended = "hasktags --ctags --extendedctag --output='$TAGS' '$SOURCES'" taggerCmdRun :: Codex -> FilePath -> FilePath -> Action FilePath -taggerCmdRun cx sources tags = do - tryIO $ system command - return tags where - command = replace "$SOURCES" sources $ replace "$TAGS" tags $ tagsCmd cx +taggerCmdRun cx sources tags' = do + _ <- tryIO $ system command + return tags' where + command = replace "$SOURCES" sources $ replace "$TAGS" tags' $ tagsCmd cx -- TODO It would be much better to work out which `Exception`s are thrown by which operations, -- and store all of that in a ADT. For now, I'll just be lazy. @@ -116,33 +113,33 @@ url = packageUrl i extract :: Codex -> PackageIdentifier -> Action FilePath -extract cx i = fmap (const path) . tryIO $ read path (packageArchive cx i) where - read dir tar = Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar +extract cx i = fmap (const path) . tryIO $ read' path (packageArchive cx i) where + read' dir tar = Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar path = packagePath cx i tags :: Codex -> PackageIdentifier -> Action FilePath -tags cx i = taggerCmdRun cx sources tags where +tags cx i = taggerCmdRun cx sources tags' where sources = packageSources cx i - tags = packageTags cx i + tags' = packageTags cx i assembly :: Codex -> [PackageIdentifier] -> String -> [WorkspaceProject] -> FilePath -> Action FilePath assembly cx dependencies projectHash workspaceProjects o = do xs <- 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 - ys <- traverse (tags tmp) xs + ys <- traverse (tags'' tmp) xs return $ Just ys where - tags tmp (WorkspaceProject identifier sources) = taggerCmdRun cx sources tags where - tags = tmp concat [display identifier, ".tags"] - mergeTags files o = do - contents <- traverse TLIO.readFile files + tags'' tmp (WorkspaceProject id' sources) = taggerCmdRun cx sources tags''' where + tags''' = tmp concat [display id', ".tags"] + mergeTags files' o' = do + contents <- traverse TLIO.readFile files' let xs = concat $ fmap TextL.lines contents let ys = if sorted then List.sort xs else xs - TLIO.writeFile o $ TextL.unlines (concat [headers, ys]) - tags i = packageTags cx i + TLIO.writeFile o' $ TextL.unlines (concat [headers, ys]) + tags' i = packageTags cx i 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"] diff --git a/src/Codex/Internal.hs b/src/Codex/Internal.hs --- a/src/Codex/Internal.hs +++ b/src/Codex/Internal.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} module Codex.Internal where -import Control.Arrow import Data.Char (isSpace) +import Data.Yaml import Distribution.Package import Distribution.Text -import Distribution.Verbosity +import GHC.Generics import System.FilePath import qualified Data.List as L @@ -21,9 +23,13 @@ , tagsFileName :: FilePath } deriving Show +deriving instance Generic Codex +instance ToJSON Codex +instance FromJSON Codex + packagePath :: Codex -> PackageIdentifier -> FilePath packagePath cx i = hackagePath cx relativePath i where - relativePath i = name version where + relativePath _ = name version where name = display $ pkgName i version = display $ pkgVersion i diff --git a/src/Codex/Project.hs b/src/Codex/Project.hs --- a/src/Codex/Project.hs +++ b/src/Codex/Project.hs @@ -1,11 +1,9 @@ module Codex.Project where import Control.Exception (try, SomeException) -import Data.Functor import Data.Function import Data.Maybe import Data.String.Utils -import Data.Traversable (traverse) import Distribution.InstalledPackageInfo import Distribution.Hackage.DB (Hackage, readHackage) import Distribution.Package @@ -15,7 +13,6 @@ import Distribution.Simple.Configure import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex -import Distribution.Package import Distribution.Verbosity import Distribution.Version import System.Directory @@ -70,8 +67,7 @@ resolveInstalledDependencies :: FilePath -> IO (Either SomeException [PackageIdentifier]) resolveInstalledDependencies root = try $ do lbi <- getPersistBuildConfig distPref - let pkg = localPkgDescr lbi - ipkgs = installedPkgs lbi + let ipkgs = installedPkgs lbi clbis = snd <$> allComponentsInBuildOrder lbi pkgs = componentPackageDeps =<< clbis ys = (maybeToList . lookupInstalledPackageId ipkgs) =<< fmap fst pkgs @@ -81,7 +77,7 @@ resolveHackageDependencies :: Hackage -> GenericPackageDescription -> [GenericPackageDescription] resolveHackageDependencies db pd = maybeToList . resolveDependency db =<< allDependencies pd where - resolveDependency db (Dependency (PackageName name) versionRange) = do + resolveDependency _ (Dependency (PackageName name) versionRange) = do pdsByVersion <- Map.lookup name db latest <- List.find (\x -> withinRange x versionRange) $ List.reverse $ List.sort $ Map.keys pdsByVersion Map.lookup latest pdsByVersion @@ -90,13 +86,13 @@ resolvePackageDependencies root pd = do xs <- either (fallback pd) return =<< resolveInstalledDependencies root return xs where - fallback pd e = do + fallback pd' e = do putStrLn $ concat ["cabal: ", show e] putStrLn "codex: *warning* falling back on dependency resolution using hackage" - resolveWithHackage pd - resolveWithHackage pd = do + resolveWithHackage pd' + resolveWithHackage pd' = do db <- readHackage - return $ identifier <$> resolveHackageDependencies db pd + return $ identifier <$> resolveHackageDependencies db pd' resolveSandboxDependencies :: FilePath -> IO [WorkspaceProject] resolveSandboxDependencies root = @@ -112,7 +108,7 @@ xs <- traverse readWorkspaceProject $ projects fileContent return $ xs >>= maybeToList where projects :: String -> [FilePath] - projects x = sources x >>= (\x -> fst <$> snd x) + projects x = sources x >>= (\x' -> fst <$> snd x') sources :: String -> [(String, [(FilePath, Int)])] sources x = read x diff --git a/src/Distribution/Sandbox/Utils.hs b/src/Distribution/Sandbox/Utils.hs --- a/src/Distribution/Sandbox/Utils.hs +++ b/src/Distribution/Sandbox/Utils.hs @@ -1,9 +1,7 @@ module Distribution.Sandbox.Utils where -import Control.Applicative ((<$>)) import System.Directory (doesFileExist) import System.FilePath (()) -import System.IO (readFile) import Data.Maybe (mapMaybe, listToMaybe) import Codex.Internal @@ -28,7 +26,7 @@ fileContent <- readFile sourcesFile return $ projects fileContent where projects :: String -> [FilePath] - projects x = sources x >>= (\x -> fmap fst $ snd x) + projects x = sources x >>= (\x' -> fmap fst $ snd x') sources :: String -> [(String, [(FilePath, Int)])] sources x = read x sourcesFile = sandboxPath "add-source-timestamps"