hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'remove-zipp'

Browse Source
This commit is contained in:
Julian Ospald 2021-08-29 23:11:03 +02:00
commit b35fe15703
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
8 changed files with 126 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cabal.project
View File

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

2
ghcup.cabal
View File

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

1
lib/GHCup.hs
View File

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

3
lib/GHCup/Download.hs
View File

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

10
lib/GHCup/Utils.hs
View File

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

1
lib/GHCup/Utils/File/Common.hs
View File

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

119
lib/GHCup/Utils/Prelude.hs
View File

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

6
stack.yaml
View File

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