codex 0.2.1.10 → 0.3

raw patch · 5 files changed

+56/−148 lines, 5 filesdep +cryptohashdep +http-clientdep +lensdep −curldep ~MissingHdep ~basedep ~codexPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptohash, http-client, lens, network, wreq

Dependencies removed: curl

Dependency ranges changed: MissingH, base, codex, hackage-db, yaml

API changes (from Hackage documentation)

Files

• codex.cabal +11/−7
• codex/Main.hs +10/−8
• src/Codex.hs +33/−15
• src/Codex/Project.hs +2/−3
• src/Network/Curl/DownloadLazy.hs +0/−115

@@ -1,5 +1,5 @@ name:                codex-version:             0.2.1.10+version:             0.3 synopsis:            A ctags file generator for cabal project dependencies. description:   This tool download and cache the source code of packages in your local hackage,@@ -29,26 +29,27 @@     Codex.Project     Codex.Internal     Distribution.Sandbox.Utils-  other-modules:-    Network.Curl.DownloadLazy   build-depends:       base                >= 4.6.0.1    && < 5     , bytestring          >= 0.10.0.2   && < 0.11     , Cabal               >= 1.18       && < 1.23+    , cryptohash          >= 0.11       && < 0.12     , containers          >= 0.5.0.0    && < 0.6-    , curl                >= 1.3.8      && < 1.4     , directory           >= 1.2.0.1    && < 1.3     , either              >= 4.3.0.1    && < 4.4     , filepath            >= 1.3.0.1    && < 1.5-    , hackage-db          >= 1.8        && < 2+    , hackage-db          >= 1.22       && < 2+    , http-client         >= 0.4        && < 0.5+    , lens                >= 4.6        && < 5     , machines            >= 0.2        && < 0.6     , machines-directory  >= 0.0.0.2    && < 0.3-    , MissingH            >= 1.2.1.0    && < 1.4+    -- , 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+    , wreq                >= 0.3.0.1    && < 0.5     , zlib                >= 0.5.4.1    && < 0.6  executable codex@@ -72,7 +73,10 @@     , MissingH     , yaml     , monad-loops         >= 0.4.2      && < 0.5-    , codex               == 0.2.1.10+    , network             >= 2.6        && < 2.7+    , wreq+    , yaml                +    , codex               == 0.3  source-repository head   type:     git

@@ -6,6 +6,8 @@ import Data.List import Data.String.Utils import Distribution.Text+import Network.Socket (withSocketsDo)+import Network.Wreq.Session (withSession) import Paths_codex (version) import System.Directory import System.Environment@@ -63,13 +65,13 @@       either (const True) id <$> (runEitherT $ isUpdateRequired cx dependencies projectHash)     else return True -  if (shouldUpdate || force) then do+  if force || shouldUpdate then do     let workspaceProjects = if not $ currentProjectIncluded cx then workspaceProjects'         else (WorkspaceProject project ".") : workspaceProjects'     fileExist <- doesFileExist tagsFile     when fileExist $ removeFile tagsFile     putStrLn $ concat ["Updating ", display project]-    results <- traverse (retrying 3 . runEitherT . getTags) dependencies+    results <- withSession $ \s -> traverse (retrying 3 . runEitherT . getTags s) dependencies     _       <- traverse print . concat $ lefts results     res     <- runEitherT $ assembly cx dependencies projectHash workspaceProjects tagsFile     either print (const $ return ()) res@@ -77,11 +79,11 @@     putStrLn "Nothing to update."   where     tagsFile = tagsFileName cx-    getTags i = status cx i >>= \x -> case x of-      (Source Tagged)   -> return ()-      (Source Untagged) -> tags cx i >> getTags i-      (Archive)         -> extract cx i >> getTags i-      (Remote)          -> fetch cx i >> getTags i+    getTags s i = status cx 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  help :: IO () help = putStrLn $@@ -100,7 +102,7 @@           , "Note: codex will browse the parent directory for cabal projects and use them as dependency over hackage when possible." ]  main :: IO ()-main = do+main = withSocketsDo $ do   cx    <- loadConfig   args  <- getArgs   run cx args where

@@ -1,17 +1,17 @@ module Codex (Codex(..), defaultTagsFileName, Verbosity, module Codex) where  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.Either-import Data.Hash.MD5 import Data.Machine import Data.Maybe-import Data.String.Utils hiding (join) import Distribution.Package import Distribution.Text import Distribution.Verbosity-import Network.Curl.DownloadLazy+import Network.HTTP.Client (HttpException) import System.Directory import System.Directory.Machine (files, directoryWalk) import System.FilePath@@ -19,17 +19,30 @@  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 Data.ByteString.Lazy as BS import qualified Data.List as List import qualified Data.Text 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  -- TODO Replace the `Codex` context with a `Control.Reader.Monad `. +-- TODO Remove that function once using `Text` widely+replace :: String -> String -> String -> String+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++ data Tagging = Tagged | Untagged   deriving (Eq, Show) @@ -46,10 +59,10 @@   deriving (Eq, Show, Read)  taggerCmd :: Tagger -> String-taggerCmd Ctags = "ctags --tag-relative=no --recurse -f '$TAGS' '$SOURCES'"-taggerCmd Hasktags = "hasktags --ctags --output='$TAGS' '$SOURCES'"-taggerCmd HasktagsEmacs = "hasktags --etags --output='$TAGS' '$SOURCES'"-taggerCmd HasktagsExtended = "hasktags --ctags --extendedctag --output='$TAGS' '$SOURCES'"+taggerCmd Ctags = "ctags --tag-relative=no --recurse -f \"$TAGS\" \"$SOURCES\""+taggerCmd Hasktags = "hasktags --ctags --output=\"$TAGS\" \"$SOURCES\""+taggerCmd HasktagsEmacs = "hasktags --etags --output=\"$TAGS\" \"$SOURCES\""+taggerCmd HasktagsExtended = "hasktags --ctags --extendedctag --output=\"$TAGS\" \"$SOURCES\""  taggerCmdRun :: Codex -> FilePath -> FilePath -> Action FilePath taggerCmdRun cx sources tags' = do@@ -65,18 +78,18 @@   either (left . show) return res  codexHash :: Codex -> String-codexHash cfg = md5s . Str $ show cfg+codexHash cfg = md5hash $ show cfg  dependenciesHash :: [PackageIdentifier] -> String-dependenciesHash xs = md5s . Str $ xs >>= display+dependenciesHash xs = md5hash $ xs >>= display  tagsFileHash :: Codex -> [PackageIdentifier] -> String -> String-tagsFileHash cx ds projectHash = md5s . Str $ concat [codexHash cx, dependenciesHash ds, projectHash]+tagsFileHash cx ds projectHash = md5hash $ concat [codexHash cx, dependenciesHash ds, projectHash]  computeCurrentProjectHash :: Codex -> IO String computeCurrentProjectHash cx = if not $ currentProjectIncluded cx then return "*" else do   xs <- runT $ (autoM getModificationTime) <~ (filtered p) <~ files <~ directoryWalk <~ source ["."]-  return . md5s . Str . show $ maximum xs+  return . md5hash . show $ maximum xs     where       p fp = any (\f -> f fp) (fmap List.isSuffixOf extensions)       extensions = [".hs", ".lhs", ".hsc"]@@ -102,16 +115,21 @@     (_, True) -> return Archive     (_, _)    -> return Remote -fetch :: Codex -> PackageIdentifier -> Action FilePath-fetch cx i = do+fetch :: WS.Session -> Codex -> PackageIdentifier -> Action FilePath+fetch s cx i = do   bs <- tryIO $ do     createDirectoryIfMissing True (packagePath cx i)-    openLazyURI url+    openLazyURI s url   either left write bs where     write bs = fmap (const archivePath) $ tryIO $ BS.writeFile archivePath bs     archivePath = packageArchive cx 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+ 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@@ -139,7 +157,7 @@       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+    tags' = packageTags 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"]

@@ -3,7 +3,6 @@ import Control.Exception (try, SomeException) import Data.Function import Data.Maybe-import Data.String.Utils import Distribution.InstalledPackageInfo import Distribution.Hackage.DB (Hackage, readHackage) import Distribution.Package@@ -43,7 +42,7 @@ findPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription) findPackageDescription root = do   files <- getDirectoryContents root-  traverse (readPackageDescription silent) $ fmap (\x -> root </> x) $ List.find (endswith ".cabal") files+  traverse (readPackageDescription silent) $ fmap (\x -> root </> x) $ List.find (List.isSuffixOf ".cabal") files  resolveCurrentProjectDependencies :: IO ProjectDependencies resolveCurrentProjectDependencies = do@@ -133,4 +132,4 @@       if isDirectory then readWorkspaceProject path else return Nothing     listDirectory fp = do       xs <- getDirectoryContents fp-      return . fmap (fp </>) $ filter (not . startswith ".") xs+      return . fmap (fp </>) $ filter (not . List.isPrefixOf ".") xs

@@ -1,115 +0,0 @@--- TODO Remove once https://github.com/GaloisInc/curl/pull/11 is released.------------------------------------------------------------------------- |--- Module    : Network.Curl.DownloadLazy--- Copyright : (c) Don Stewart--- License   : BSD3------ Stability :  provisional--- Portability: posix------ This module is equivalent to download-curl's Network.Curl.Download.Lazy--- A binding to curl, an efficient, high level library for--- retrieving files using Uniform Resource Locators (URLs).------ Content may be retrieved as a lazy "ByteString".------ Error handling is encapsulated in the "Either" type.--------------------------------------------------------------------------module Network.Curl.DownloadLazy (-        -- * The basic lazy interface to network content-          openLazyURI-        , openLazyURIWithOpts--    ) where--import           Foreign-import           Network.Curl--import           Data.IORef--import qualified Data.ByteString.Internal      as S-import qualified Data.ByteString.Lazy.Internal as L------------------------------------------------------------------------------ | Download content specified by a url using curl, returning the--- content as a lazy "ByteString".------ If an error occurs, "Left" is returned, with a--- protocol-specific error string.------ Examples:------ > openLazyURI "http://haskell.org"----openLazyURI :: String -> IO (Either String L.ByteString)-openLazyURI = openLazyURIWithOpts []---- | Like openURI, but takes curl options.------ Examples:------ > openLazyURIWithOpts [CurlPost True] "http://haskell.org"----openLazyURIWithOpts :: [CurlOption] -> String -> IO (Either String L.ByteString)-openLazyURIWithOpts opts s = case parseURL s of-     Nothing  -> return $ Left $ "Malformed url: "++ s-     Just url -> do-        e <- getFile url opts-        return $ case e of-             Left err   -> Left $ "Failed to connect: " ++ err-             Right src  -> Right src----------------------------------------------------------------------------- Internal:-----newtype URL = URL String--parseURL :: String -> Maybe URL-parseURL s = Just (URL s) -- no parsing--getFile :: URL -> [CurlOption] -> IO (Either String L.ByteString)-getFile (URL url) flags = do-    h   <- initialize-    ref <- newIORef L.Empty--    _ <- setopt h (CurlFailOnError True)-    setDefaultSSLOpts h url-    _ <- setopt h (CurlURL url)-    _ <- setopt h (CurlWriteFunction (gather ref))-    mapM_ (setopt h) flags-    rc         <- perform h-    chunks     <- readIORef ref--    return $ if rc /= CurlOK-        then Left (show rc)-        else Right $! revSpine chunks----          fp <- newForeignPtr finalizerFree buf'---          return (Right $! S.fromForeignPtr fp 0 (fromIntegral sz))--gather :: IORef L.ByteString -> WriteFunction-gather r = writer $ \chunk -> do-    chunks <- readIORef r-    let chunks' = L.Chunk chunk chunks-    writeIORef r $! chunks'---- memcpy chunks of data into our bytestring.-writer :: (S.ByteString -> IO ()) -> WriteFunction-writer f src sz nelems _ = do-    let n' = sz * nelems-    f =<< S.create (fromIntegral n') (\dest -> S.memcpy dest (castPtr src) (fromIntegral n'))-    return n'----- reverse just the spine of a lazy bytestring-revSpine :: L.ByteString -> L.ByteString-revSpine l =  rev l L.Empty-  where-    rev L.Empty a        = a-    rev (L.Chunk x xs) a = rev xs (L.Chunk x a)