diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,14 @@ the change. --> +## 0.6.0.0 + +- Bump `base` lower bound to indicate GHC 7.10 as minimum supported version. +- Support Stack lts-13 (GHC 8.6) [#93](https://github.com/aloiscochard/codex/pull/93) +- Support Stack lts-14 (GHC 8.6.5) [#101](https://github.com/aloiscochard/codex/pull/101) +- Drop Stack lts-6 Support (GHC 7.10.3) [#101](https://github.com/aloiscochard/codex/pull/101) +- Drop support for older cabal and hackage-db libraries. [#102](https://github.com/aloiscochard/codex/pull/102) + ## 0.5.2.0 This CHANGELOG entry is incomplete, as it is reconstructed from the Git history diff --git a/codex.cabal b/codex.cabal --- a/codex.cabal +++ b/codex.cabal @@ -1,5 +1,5 @@ name: codex -version: 0.5.2.0 +version: 0.6.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, @@ -33,24 +33,22 @@ Distribution.Sandbox.Utils build-depends: ascii-progress >= 0.3 - , base >= 4.6.0.1 && < 5 + , base >= 4.11 && < 5 , bytestring >= 0.10.0.2 && < 0.11 - , Cabal >= 1.18 && < 2.5 - , cryptohash >= 0.11 && < 0.12 - , containers >= 0.5.0.0 && < 0.6 - , directory >= 1.2.0.1 && < 1.4 + , conduit >= 1.3.0 + , Cabal >= 3.0 && < 3.1 + , containers >= 0.5.0.0 && < 0.7 + , cryptonite >= 0.21 && < 0.27 + , directory >= 1.2.5.0 && < 1.4 , filepath >= 1.3.0.1 && < 1.5 - , hackage-db >= 1.22 && < 3 - , http-client >= 0.4 && < 0.6 - , lens >= 4.6 && < 5 - , machines >= 0.2 && < 0.7 - , machines-directory >= 0.0.0.2 && < 0.3 + , hackage-db >= 2 && < 3 + , http-client >= 0.4 && <= 0.6.5 + , memory >= 0.13 && < 0.16 , process >= 1.2.3 && < 1.7 , tar >= 0.4.0.1 && < 0.6 , 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.6 + , yaml >= 0.8.8.3 && < 0.12 , zlib >= 0.5.4.1 && < 0.7 executable codex @@ -72,10 +70,10 @@ , directory , filepath , hackage-db - , network >= 2.6 && < 2.7 + , network >= 2.6 && < 3.2 + , http-client-tls , process , transformers - , wreq , yaml , codex diff --git a/codex/Main.hs b/codex/Main.hs --- a/codex/Main.hs +++ b/codex/Main.hs @@ -1,13 +1,7 @@ -{-# LANGUAGE CPP #-} - module Main (main) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -import Data.Traversable (traverse) -#endif - import Control.Arrow +import Network.HTTP.Client.TLS (newTlsManager) import Control.Exception (try, SomeException) import Control.Monad import Control.Monad.IO.Class (liftIO) @@ -16,8 +10,8 @@ import Data.List import qualified Distribution.Hackage.DB as DB import Distribution.Text +import Distribution.Types.Version import Network.Socket (withSocketsDo) -import Network.Wreq.Session (withSession) import Paths_codex (version) import System.Console.AsciiProgress (displayConsoleRegions) import System.Directory @@ -55,9 +49,6 @@ where hp = hackagePath cx safe = (try :: IO a -> IO (Either SomeException a)) - listDirectory fp = do - xs <- getDirectoryContents fp - return . fmap (fp ) $ filter (not . isPrefixOf ".") xs removeTagFiles = traverse (safe . removeFile) . fmap ( "tags") traverseDirectories = fmap rights . traverse (safe . listDirectory) builderOp (Stack _) = traverseDirectories . concat @@ -75,16 +66,11 @@ update :: Bool -> Codex -> Builder -> IO () update force cx bldr = displayConsoleRegions $ do -#if MIN_VERSION_hackage_db(2,0,0) (mpid, dependencies, workspaceProjects') <- case bldr of Cabal -> do tb <- DB.hackageTarball resolveCurrentProjectDependencies bldr tb Stack _ -> resolveCurrentProjectDependencies bldr $ hackagePath cx -#else - (mpid, dependencies, workspaceProjects') <- - resolveCurrentProjectDependencies bldr (hackagePath cx) -#endif projectHash <- computeCurrentProjectHash cx shouldUpdate <- if null workspaceProjects' then @@ -98,9 +84,9 @@ fileExist <- doesFileExist tagsFile when fileExist $ removeFile tagsFile putStrLn ("Updating: " ++ displayPackages mpid workspaceProjects) - results <- withSession $ \s -> do - tick' <- newProgressBar' "Loading tags" (length dependencies) - traverse (retrying 3 . runExceptT . getTags tick' s) dependencies + s <- newTlsManager + tick' <- newProgressBar' "Loading tags" (length dependencies) + results <- traverse (retrying 3 . runExceptT . getTags tick' s) dependencies _ <- traverse print . concat $ lefts results res <- runExceptT $ assembly bldr cx dependencies projectHash workspaceProjects tagsFile case res of @@ -158,7 +144,7 @@ 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 _ ["--version"] = putStrLn $ concat ["codex: ", display version] + run _ ["--version"] = putStrLn $ concat ["codex: ", display (mkVersion' version)] run _ ["--help"] = help run _ [] = help run _ args = fail' $ concat ["codex: '", intercalate " " args,"' is not a codex command. See 'codex --help'."] diff --git a/codex/Main/Config.hs b/codex/Main/Config.hs --- a/codex/Main/Config.hs +++ b/codex/Main/Config.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Main.Config where import Control.Exception (catch) @@ -14,9 +13,7 @@ import qualified Main.Config.Codex3 as C3 import qualified Distribution.Hackage.DB as DB -#if MIN_VERSION_hackage_db(2,0,0) import qualified Distribution.Hackage.DB.Errors as Errors -#endif data ConfigState = Ready | TaggerNotFound @@ -37,7 +34,6 @@ loadConfig :: IO Codex loadConfig = decodeConfig >>= maybe defaultConfig return where defaultConfig = do -#if MIN_VERSION_hackage_db(2,0,0) hp <- DB.hackageTarball `catch` \Errors.NoHackageTarballFound -> do error $ unlines @@ -46,9 +42,6 @@ , "" , " cabal update" ] -#else - hp <- DB.hackagePath -#endif let cx = Codex True (dropFileName hp) defaultStackOpts (taggerCmd Hasktags) True True defaultTagsFileName encodeConfig cx return cx @@ -104,4 +97,3 @@ return $ eitherToMaybe res eitherToMaybe x = either (const Nothing) Just x - diff --git a/src/Codex.hs b/src/Codex.hs --- a/src/Codex.hs +++ b/src/Codex.hs @@ -1,43 +1,33 @@ -{-# LANGUAGE CPP #-} module Codex (Codex(..), defaultStackOpts, defaultTagsFileName, Verbosity, module Codex) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (<*)) -import Data.Traversable (traverse) -#endif - +import Network.HTTP.Client (httpLbs, Manager, Response(..), parseRequest) import Control.Exception (try, SomeException) -import Control.Lens ((^.)) -import Control.Lens.Review (bimap) import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Except -import Data.Machine -import Data.Maybe import Data.List ((\\)) +import Conduit +import Data.Maybe import Distribution.Package 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 import System.Process +import qualified Data.ByteArray.Encoding as BA import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip -import qualified Crypto.Hash.MD5 as MD5 -import qualified Data.ByteString.Char8 as C8 +import qualified Crypto.Hash as Crypto import qualified Data.ByteString.Lazy as BS import qualified Data.List as List import qualified Data.Set as Set import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as TextL import qualified Data.Text.Lazy.IO as TLIO -import qualified Network.Wreq as W -import qualified Network.Wreq.Session as WS -import qualified Text.Printf as Printf import Codex.Internal import Codex.Project @@ -49,8 +39,9 @@ replace a b c = Text.unpack $ Text.replace (Text.pack a) (Text.pack b) (Text.pack c) md5hash :: String -> String -md5hash = concatMap (Printf.printf "%02x") . C8.unpack . MD5.hash . C8.pack - +md5hash = Text.unpack . Text.decodeUtf8 . md5 . Text.encodeUtf8 . Text.pack + where + md5 = BA.convertToBase BA.Base16 . Crypto.hashWith Crypto.MD5 data Tagging = Tagged | Untagged deriving (Eq, Show) @@ -97,7 +88,12 @@ computeCurrentProjectHash :: Codex -> IO String computeCurrentProjectHash cx = if not $ currentProjectIncluded cx then return "*" else do - xs <- runT $ (autoM getModificationTime) <~ (filtered p) <~ files <~ directoryWalk <~ source ["."] + -- xs <- runT $ (autoM getModificationTime) <~ (filtered p) <~ files <~ directoryWalk <~ source ["."] + xs <- runConduitRes + $ sourceDirectoryDeep True "." + .| filterC p + .| mapMC (lift . getModificationTime) + .| sinkList return . md5hash . show $ maximum xs where p fp = any (\f -> f fp) (fmap List.isSuffixOf extensions) @@ -124,7 +120,7 @@ (_, True) -> return Archive (_, _) -> return Remote -fetch :: WS.Session -> FilePath -> PackageIdentifier -> Action FilePath +fetch :: Manager -> FilePath -> PackageIdentifier -> Action FilePath fetch s root i = do bs <- tryIO $ do createDirectoryIfMissing True (packagePath root i) @@ -134,10 +130,18 @@ archivePath = packageArchive root i url = packageUrl i -openLazyURI :: WS.Session -> String -> IO (Either String BS.ByteString) -openLazyURI s = fmap (bimap showHttpEx (^. W.responseBody)) . try . WS.get s where - showHttpEx :: HttpException -> String - showHttpEx = show +openLazyURI :: Manager -> String -> IO (Either String BS.ByteString) +openLazyURI manager url = do + request <- parseRequest url + eresp <- try $ httpLbs request manager + pure $ case eresp of + Left err -> + Left $ showHttpEx err + Right resp -> + Right $ responseBody resp + where + showHttpEx :: HttpException -> String + showHttpEx = show extract :: FilePath -> PackageIdentifier -> Action FilePath extract root i = fmap (const path) . tryIO $ read' path (packageArchive root i) where diff --git a/src/Codex/Internal.hs b/src/Codex/Internal.hs --- a/src/Codex/Internal.hs +++ b/src/Codex/Internal.hs @@ -1,11 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -module Codex.Internal where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif +module Codex.Internal where import Data.Char (isSpace) import Data.Yaml @@ -107,7 +103,9 @@ s <- readCreateProcess (shell "stack --version") "" let versionText = + if ',' `elem` s then takeWhile (/= ',') (drop (length "Version ") s) + else takeWhile (/= ' ') s parsed = readP_to_S parseVersion versionText case parsed of 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,5 @@ -{-# LANGUAGE CPP #-} module Codex.Project where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -import Data.Traversable (traverse) -#endif - import Control.Applicative ((<|>)) import Control.Exception (try, SomeException) import Control.Monad (filterM) @@ -14,18 +8,10 @@ import Data.List (delete, isPrefixOf, union) import Data.Maybe import Distribution.InstalledPackageInfo -#if MIN_VERSION_hackage_db(2,0,0) import Distribution.Hackage.DB (HackageDB, cabalFile, readTarball) -#else -import Distribution.Hackage.DB (Hackage, readHackage') -#endif import Distribution.Package import Distribution.PackageDescription -#if MIN_VERSION_Cabal(2,2,0) import Distribution.PackageDescription.Parsec -#else -import Distribution.PackageDescription.Parse -#endif import Distribution.Sandbox.Utils (findSandbox) import Distribution.Simple.Configure import Distribution.Simple.LocalBuildInfo @@ -39,15 +25,10 @@ import qualified Data.List as List import qualified Data.Map as Map -#if !MIN_VERSION_hackage_db(2,0,0) -import qualified Data.Version as Base -#endif import Codex.Internal (Builder(..), stackListDependencies) -#if MIN_VERSION_hackage_db(2,0,0) type Hackage = HackageDB -#endif newtype Workspace = Workspace [WorkspaceProject] deriving (Eq, Show) @@ -66,17 +47,13 @@ eds = (condTreeConstraints . snd) =<< condExecutables pd tds = (condTreeConstraints . snd) =<< condTestSuites pd bds = (condTreeConstraints . snd) =<< condBenchmarks pd - isCurrent (Dependency n _) = n == (pkgName $ identifier pd) + isCurrent (Dependency n _ _) = n == (pkgName $ identifier pd) findPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription) findPackageDescription root = do mpath <- findCabalFilePath root traverse ( -#if MIN_VERSION_Cabal(2,2,0) readGenericPackageDescription -#else - readPackageDescription -#endif silent) mpath -- | Find a regular file ending with ".cabal" within a directory. @@ -148,7 +125,7 @@ let ipkgs = installedPkgs lbi clbis = allComponentsInBuildOrder' lbi pkgs = componentPackageDeps =<< clbis - ys = (maybeToList . lookupInstalledPackageId ipkgs) =<< fmap fst pkgs + ys = (maybeToList . lookupUnitId ipkgs) =<< fmap fst pkgs xs = fmap sourcePackageId $ ys return xs where withCabal = getPersistBuildConfig $ root "dist" @@ -160,38 +137,19 @@ allComponentsInBuildOrder' :: LocalBuildInfo -> [ComponentLocalBuildInfo] allComponentsInBuildOrder' = -#if MIN_VERSION_Cabal(2,0,0) allComponentsInBuildOrder -#else - fmap snd . allComponentsInBuildOrder -#endif resolveHackageDependencies :: Hackage -> GenericPackageDescription -> [GenericPackageDescription] resolveHackageDependencies db pd = maybeToList . resolveDependency db =<< allDependencies pd where - resolveDependency _ (Dependency name versionRange) = do + resolveDependency _ (Dependency name versionRange _) = do pdsByVersion <- lookupName name latest <- List.find (\x -> withinRange' x versionRange) $ List.reverse $ List.sort $ Map.keys pdsByVersion lookupVersion latest pdsByVersion -#if MIN_VERSION_hackage_db(2,0,0) lookupName name = Map.lookup name db lookupVersion latest pdsByVersion = cabalFile <$> Map.lookup latest pdsByVersion -#else - lookupName name = Map.lookup (unPackageName name) db - lookupVersion latest pdsByVersion = Map.lookup latest pdsByVersion -#endif -#if MIN_VERSION_hackage_db(2,0,0) withinRange' :: Version -> VersionRange -> Bool withinRange' = withinRange -#else -withinRange' :: Base.Version -> VersionRange -> Bool -withinRange' = -#if MIN_VERSION_Cabal(2,0,0) - withinRange . mkVersion' -#else - withinRange -#endif -#endif resolvePackageDependencies :: Builder -> FilePath -> FilePath -> GenericPackageDescription -> IO [PackageIdentifier] resolvePackageDependencies bldr hackagePath root pd = do @@ -202,13 +160,8 @@ putStrLn "codex: *warning* falling back on dependency resolution using hackage" resolveWithHackage resolveWithHackage = do -#if MIN_VERSION_hackage_db(2,0,0) db <- readTarball Nothing (hackagePath "00-index.tar") - <|> readTarball Nothing (hackagePath "01-index.tar") -#else - db <- readHackage' (hackagePath "00-index.tar") - <|> readHackage' (hackagePath "01-index.tar") -#endif + <|> readTarball Nothing hackagePath return $ identifier <$> resolveHackageDependencies db pd resolveSandboxDependencies :: FilePath -> IO [WorkspaceProject] @@ -231,7 +184,7 @@ 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 readWorkspaceProject :: FilePath -> IO (Maybe WorkspaceProject)