diff --git a/cabal.project b/cabal.project index bbc95b2..224e03a 100644 --- a/cabal.project +++ b/cabal.project @@ -16,7 +16,7 @@ source-repository-package source-repository-package type: git location: https://github.com/hasufell/libarchive - tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99 + tag: 8587aab78dd515928024ecd82c8f215e06db85cd constraints: http-io-streams -brotli diff --git a/ghcup.cabal b/ghcup.cabal index 4c1d676..432c8f0 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -104,7 +104,6 @@ library , deepseq ^>=1.4.4.0 , directory ^>=1.3.6.0 , disk-free-space ^>=0.1.0.1 - , extra ^>=1.7.9 , filepath ^>=1.4.2.1 , haskus-utils-types ^>=1.5 , haskus-utils-variant >=3.0 && <3.2 @@ -135,7 +134,6 @@ library , versions >=4.0.1 && <5.1 , word8 ^>=0.1.3 , yaml ^>=0.11.4.0 - , zip ^>=1.7.1 , zlib ^>=0.6.2.2 if (flag(internal-downloader) && !os(windows)) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 0489714..4df6afb 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -58,7 +58,6 @@ import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) ) import Data.ByteString ( ByteString ) import Data.Either import Data.List -import Data.List.Extra import Data.Maybe import Data.String ( fromString ) import Data.Text ( Text ) diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index b26c949..d72b7f7 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -57,8 +57,8 @@ import Data.ByteString ( ByteString ) #if defined(INTERNAL_DOWNLOADER) import Data.CaseInsensitive ( mk ) #endif -import Data.List.Extra import Data.Maybe +import Data.List import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Versions @@ -72,6 +72,7 @@ import Prelude hiding ( abs , readFile , writeFile ) +import Safe import System.Directory import System.Environment import System.Exit diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 7971762..f911224 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -40,7 +40,6 @@ import GHCup.Utils.Prelude import GHCup.Utils.String.QQ import Codec.Archive hiding ( Directory ) -import Codec.Archive.Zip import Control.Applicative import Control.Exception.Safe import Control.Monad @@ -59,7 +58,6 @@ import Data.ByteString ( ByteString ) import Data.Either import Data.Foldable import Data.List -import Data.List.Extra import Data.List.NonEmpty ( NonEmpty( (:|) )) import Data.Maybe import Data.Text ( Text ) @@ -628,8 +626,7 @@ unpackToDir dfp av = do | ".tar.bz2" `isSuffixOf` fn -> liftE (untar . BZip.decompress =<< rf av) | ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av) - | ".zip" `isSuffixOf` fn -> - withArchive av (unpackInto dfp) + | ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av) | otherwise -> throwE $ UnknownArchive fn @@ -658,10 +655,7 @@ getArchiveFiles av = do | ".tar.bz2" `isSuffixOf` fn -> liftE (entries . BZip.decompress =<< rf av) | ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av) - | ".zip" `isSuffixOf` fn -> - withArchive av $ do - entries' <- getEntries - pure $ fmap unEntrySelector $ Map.keys entries' + | ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av) | otherwise -> throwE $ UnknownArchive fn diff --git a/lib/GHCup/Utils/File/Common.hs b/lib/GHCup/Utils/File/Common.hs index ca60ea3..3aac1ea 100644 --- a/lib/GHCup/Utils/File/Common.hs +++ b/lib/GHCup/Utils/File/Common.hs @@ -7,7 +7,6 @@ module GHCup.Utils.File.Common where import GHCup.Utils.Prelude -import Control.Monad.Extra import Control.Monad.Reader import Data.Maybe import GHC.IO.Exception diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs index 22f758d..dc0601e 100644 --- a/lib/GHCup/Utils/Prelude.hs +++ b/lib/GHCup/Utils/Prelude.hs @@ -33,7 +33,8 @@ import Control.Monad.Reader import Control.Monad.Logger import Data.Bifunctor import Data.ByteString ( ByteString ) -import Data.List ( nub, intercalate ) +import Data.List ( nub, intercalate, stripPrefix, isPrefixOf ) +import Data.Maybe import Data.Foldable import Data.String import Data.Text ( Text ) @@ -76,6 +77,8 @@ import qualified System.Win32.File as Win32 -- >>> import Test.QuickCheck -- >>> import Data.Word8 -- >>> import qualified Data.Text as T +-- >>> import qualified Data.Char as C +-- >>> import Data.List -- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary @@ -580,3 +583,117 @@ splitOnPVP c s = case Split.splitOn c s of | otherwise -> def where def = (s, "") + + + +-- | Like 'find', but where the test can be monadic. +-- +-- >>> findM (Just . C.isUpper) "teST" +-- Just (Just 'S') +-- >>> findM (Just . C.isUpper) "test" +-- Just Nothing +-- >>> findM (Just . const True) ["x",undefined] +-- Just (Just "x") +findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) +findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing) + + +-- | Drops the given suffix from a list. +-- It returns the original sequence if the sequence doesn't end with the given suffix. +-- +-- >>> dropSuffix "!" "Hello World!" +-- "Hello World" +-- >>> dropSuffix "!" "Hello World!!" +-- "Hello World!" +-- >>> dropSuffix "!" "Hello World." +-- "Hello World." +dropSuffix :: Eq a => [a] -> [a] -> [a] +dropSuffix a b = fromMaybe b $ stripSuffix a b + +-- | Return the prefix of the second list if its suffix +-- matches the entire first list. +-- +-- >>> stripSuffix "bar" "foobar" +-- Just "foo" +-- >>> stripSuffix "" "baz" +-- Just "baz" +-- >>> stripSuffix "foo" "quux" +-- Nothing +stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] +stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b) + + +-- | Drops the given prefix from a list. +-- It returns the original sequence if the sequence doesn't start with the given prefix. +-- +-- >>> dropPrefix "Mr. " "Mr. Men" +-- "Men" +-- >>> dropPrefix "Mr. " "Dr. Men" +-- "Dr. Men" +dropPrefix :: Eq a => [a] -> [a] -> [a] +dropPrefix a b = fromMaybe b $ stripPrefix a b + + + +-- | Break a list into pieces separated by the first +-- list argument, consuming the delimiter. An empty delimiter is +-- invalid, and will cause an error to be raised. +-- +-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne" +-- ["a","b","d","e"] +-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa" +-- ["","X","X","X",""] +-- >>> splitOn "x" "x" +-- ["",""] +-- >>> splitOn "x" "" +-- [""] +-- +-- prop> \s x -> s /= "" ==> intercalate s (splitOn s x) == x +-- prop> \c x -> splitOn [c] x == split (==c) x +splitOn :: Eq a => [a] -> [a] -> [[a]] +splitOn [] _ = error "splitOn, needle may not be empty" +splitOn _ [] = [[]] +splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b + where (a,b) = breakOn needle haystack + + +-- | Splits a list into components delimited by separators, +-- where the predicate returns True for a separator element. The +-- resulting components do not contain the separators. Two adjacent +-- separators result in an empty component in the output. +-- +-- >>> split (== 'a') "aabbaca" +-- ["","","bb","c",""] +-- >>> split (== 'a') "" +-- [""] +-- >>> split (== ':') "::xyz:abc::123::" +-- ["","","xyz","abc","","123","",""] +-- >>> split (== ',') "my,list,here" +-- ["my","list","here"] +split :: (a -> Bool) -> [a] -> [[a]] +split _ [] = [[]] +split f (x:xs) + | f x = [] : split f xs + | y:ys <- split f xs = (x:y) : ys + | otherwise = [[]] + + +-- | Find the first instance of @needle@ in @haystack@. +-- The first element of the returned tuple +-- is the prefix of @haystack@ before @needle@ is matched. The second +-- is the remainder of @haystack@, starting with the match. +-- If you want the remainder /without/ the match, use 'stripInfix'. +-- +-- >>> breakOn "::" "a::b::c" +-- ("a","::b::c") +-- >>> breakOn "/" "foobar" +-- ("foobar","") +-- +-- prop> \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack +breakOn :: Eq a => [a] -> [a] -> ([a], [a]) +breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack) +breakOn _ [] = ([], []) +breakOn needle (x:xs) = first (x:) $ breakOn needle xs + + + diff --git a/stack.yaml b/stack.yaml index fcef979..3da1699 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-18.7 +resolver: lts-18.2 packages: - . @@ -6,8 +6,9 @@ packages: extra-deps: - git: https://github.com/bgamari/terminal-size commit: 34ea816bd63f75f800eedac12c6908c6f3736036 + - git: https://github.com/hasufell/libarchive - commit: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99 + commit: 8587aab78dd515928024ecd82c8f215e06db85cd - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530 - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 @@ -41,7 +42,6 @@ extra-deps: - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138 - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248 - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - - zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918 flags: http-io-streams: