codex 0.2.1.8 → 0.2.1.10

raw patch · 7 files changed

+60/−71 lines, 7 filesdep ~basedep ~codexdep ~machinesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, codex, machines, yaml

API changes (from Hackage documentation)

Files

• codex.cabal +7/−6
• codex/Main.hs +12/−14
• codex/Main/Config.hs +8/−15
• src/Codex.hs +16/−19
• src/Codex/Internal.hs +9/−3
• src/Codex/Project.hs +7/−11
• src/Distribution/Sandbox/Utils.hs +1/−3

@@ -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

@@ -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) 

@@ -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 

@@ -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"]

@@ -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 

@@ -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 

@@ -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"