{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.Types.Repo (
RemoteRepo (..),
emptyRemoteRepo,
LocalRepo (..),
emptyLocalRepo,
localRepoCacheKey,
Repo (..),
repoName,
isRepoRemote,
maybeRepoRemote,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Network.URI (URI (..), nullURI, parseAbsoluteURI, uriToString)
import Distribution.Simple.Utils (toUTF8BS)
import Distribution.Client.HashValue (hashValue, showHashValue, truncateHash)
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
import Distribution.Client.Types.RepoName
data RemoteRepo =
RemoteRepo {
RemoteRepo -> RepoName
remoteRepoName :: RepoName,
RemoteRepo -> URI
remoteRepoURI :: URI,
RemoteRepo -> Maybe Bool
remoteRepoSecure :: Maybe Bool,
RemoteRepo -> [FilePath]
remoteRepoRootKeys :: [String],
RemoteRepo -> Int
remoteRepoKeyThreshold :: Int,
RemoteRepo -> Bool
remoteRepoShouldTryHttps :: Bool
}
deriving (Int -> RemoteRepo -> ShowS
[RemoteRepo] -> ShowS
RemoteRepo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RemoteRepo] -> ShowS
$cshowList :: [RemoteRepo] -> ShowS
show :: RemoteRepo -> FilePath
$cshow :: RemoteRepo -> FilePath
showsPrec :: Int -> RemoteRepo -> ShowS
$cshowsPrec :: Int -> RemoteRepo -> ShowS
Show, RemoteRepo -> RemoteRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteRepo -> RemoteRepo -> Bool
$c/= :: RemoteRepo -> RemoteRepo -> Bool
== :: RemoteRepo -> RemoteRepo -> Bool
$c== :: RemoteRepo -> RemoteRepo -> Bool
Eq, Eq RemoteRepo
RemoteRepo -> RemoteRepo -> Bool
RemoteRepo -> RemoteRepo -> Ordering
RemoteRepo -> RemoteRepo -> RemoteRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RemoteRepo -> RemoteRepo -> RemoteRepo
$cmin :: RemoteRepo -> RemoteRepo -> RemoteRepo
max :: RemoteRepo -> RemoteRepo -> RemoteRepo
$cmax :: RemoteRepo -> RemoteRepo -> RemoteRepo
>= :: RemoteRepo -> RemoteRepo -> Bool
$c>= :: RemoteRepo -> RemoteRepo -> Bool
> :: RemoteRepo -> RemoteRepo -> Bool
$c> :: RemoteRepo -> RemoteRepo -> Bool
<= :: RemoteRepo -> RemoteRepo -> Bool
$c<= :: RemoteRepo -> RemoteRepo -> Bool
< :: RemoteRepo -> RemoteRepo -> Bool
$c< :: RemoteRepo -> RemoteRepo -> Bool
compare :: RemoteRepo -> RemoteRepo -> Ordering
$ccompare :: RemoteRepo -> RemoteRepo -> Ordering
Ord, forall x. Rep RemoteRepo x -> RemoteRepo
forall x. RemoteRepo -> Rep RemoteRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteRepo x -> RemoteRepo
$cfrom :: forall x. RemoteRepo -> Rep RemoteRepo x
Generic)
instance Binary RemoteRepo
instance Structured RemoteRepo
instance Pretty RemoteRepo where
pretty :: RemoteRepo -> Doc
pretty RemoteRepo
r =
forall a. Pretty a => a -> Doc
pretty (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
r) Doc -> Doc -> Doc
<<>> Doc
Disp.colon Doc -> Doc -> Doc
<<>>
FilePath -> Doc
Disp.text (ShowS -> URI -> ShowS
uriToString forall a. a -> a
id (RemoteRepo -> URI
remoteRepoURI RemoteRepo
r) [])
instance Parsec RemoteRepo where
parsec :: forall (m :: * -> *). CabalParsing m => m RemoteRepo
parsec = do
RepoName
name <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
FilePath
uriStr <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m FilePath
P.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (FilePath
"+-=._/*()@'$:;&!?~" :: String))
URI
uri <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot parse URI:" forall a. [a] -> [a] -> [a]
++ FilePath
uriStr) forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe URI
parseAbsoluteURI FilePath
uriStr)
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteRepo
{ remoteRepoName :: RepoName
remoteRepoName = RepoName
name
, remoteRepoURI :: URI
remoteRepoURI = URI
uri
, remoteRepoSecure :: Maybe Bool
remoteRepoSecure = forall a. Maybe a
Nothing
, remoteRepoRootKeys :: [FilePath]
remoteRepoRootKeys = []
, remoteRepoKeyThreshold :: Int
remoteRepoKeyThreshold = Int
0
, remoteRepoShouldTryHttps :: Bool
remoteRepoShouldTryHttps = Bool
False
}
emptyRemoteRepo :: RepoName -> RemoteRepo
emptyRemoteRepo :: RepoName -> RemoteRepo
emptyRemoteRepo RepoName
name = RepoName
-> URI -> Maybe Bool -> [FilePath] -> Int -> Bool -> RemoteRepo
RemoteRepo RepoName
name URI
nullURI forall a. Maybe a
Nothing [] Int
0 Bool
False
data LocalRepo = LocalRepo
{ LocalRepo -> RepoName
localRepoName :: RepoName
, LocalRepo -> FilePath
localRepoPath :: FilePath
, LocalRepo -> Bool
localRepoSharedCache :: Bool
}
deriving (Int -> LocalRepo -> ShowS
[LocalRepo] -> ShowS
LocalRepo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LocalRepo] -> ShowS
$cshowList :: [LocalRepo] -> ShowS
show :: LocalRepo -> FilePath
$cshow :: LocalRepo -> FilePath
showsPrec :: Int -> LocalRepo -> ShowS
$cshowsPrec :: Int -> LocalRepo -> ShowS
Show, LocalRepo -> LocalRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalRepo -> LocalRepo -> Bool
$c/= :: LocalRepo -> LocalRepo -> Bool
== :: LocalRepo -> LocalRepo -> Bool
$c== :: LocalRepo -> LocalRepo -> Bool
Eq, Eq LocalRepo
LocalRepo -> LocalRepo -> Bool
LocalRepo -> LocalRepo -> Ordering
LocalRepo -> LocalRepo -> LocalRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LocalRepo -> LocalRepo -> LocalRepo
$cmin :: LocalRepo -> LocalRepo -> LocalRepo
max :: LocalRepo -> LocalRepo -> LocalRepo
$cmax :: LocalRepo -> LocalRepo -> LocalRepo
>= :: LocalRepo -> LocalRepo -> Bool
$c>= :: LocalRepo -> LocalRepo -> Bool
> :: LocalRepo -> LocalRepo -> Bool
$c> :: LocalRepo -> LocalRepo -> Bool
<= :: LocalRepo -> LocalRepo -> Bool
$c<= :: LocalRepo -> LocalRepo -> Bool
< :: LocalRepo -> LocalRepo -> Bool
$c< :: LocalRepo -> LocalRepo -> Bool
compare :: LocalRepo -> LocalRepo -> Ordering
$ccompare :: LocalRepo -> LocalRepo -> Ordering
Ord, forall x. Rep LocalRepo x -> LocalRepo
forall x. LocalRepo -> Rep LocalRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalRepo x -> LocalRepo
$cfrom :: forall x. LocalRepo -> Rep LocalRepo x
Generic)
instance Binary LocalRepo
instance Structured LocalRepo
instance Parsec LocalRepo where
parsec :: forall (m :: * -> *). CabalParsing m => m LocalRepo
parsec = do
RepoName
n <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
FilePath
p <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m FilePath
P.munch1 (forall a b. a -> b -> a
const Bool
True)
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoName -> FilePath -> Bool -> LocalRepo
LocalRepo RepoName
n FilePath
p Bool
False)
instance Pretty LocalRepo where
pretty :: LocalRepo -> Doc
pretty (LocalRepo RepoName
n FilePath
p Bool
_) = forall a. Pretty a => a -> Doc
pretty RepoName
n Doc -> Doc -> Doc
<<>> Doc
Disp.colon Doc -> Doc -> Doc
<<>> FilePath -> Doc
Disp.text FilePath
p
emptyLocalRepo :: RepoName -> LocalRepo
emptyLocalRepo :: RepoName -> LocalRepo
emptyLocalRepo RepoName
name = RepoName -> FilePath -> Bool -> LocalRepo
LocalRepo RepoName
name FilePath
"" Bool
False
localRepoCacheKey :: LocalRepo -> String
localRepoCacheKey :: LocalRepo -> FilePath
localRepoCacheKey LocalRepo
local = RepoName -> FilePath
unRepoName (LocalRepo -> RepoName
localRepoName LocalRepo
local) forall a. [a] -> [a] -> [a]
++ FilePath
"-" forall a. [a] -> [a] -> [a]
++ FilePath
hashPart where
hashPart :: FilePath
hashPart
= HashValue -> FilePath
showHashValue forall a b. (a -> b) -> a -> b
$ Int -> HashValue -> HashValue
truncateHash Int
8 forall a b. (a -> b) -> a -> b
$ ByteString -> HashValue
hashValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
toUTF8BS forall a b. (a -> b) -> a -> b
$ LocalRepo -> FilePath
localRepoPath LocalRepo
local
data Repo
= RepoLocalNoIndex
{ Repo -> LocalRepo
repoLocal :: LocalRepo
, Repo -> FilePath
repoLocalDir :: FilePath
}
| RepoRemote {
Repo -> RemoteRepo
repoRemote :: RemoteRepo
, repoLocalDir :: FilePath
}
| RepoSecure {
repoRemote :: RemoteRepo
, repoLocalDir :: FilePath
}
deriving (Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Repo] -> ShowS
$cshowList :: [Repo] -> ShowS
show :: Repo -> FilePath
$cshow :: Repo -> FilePath
showsPrec :: Int -> Repo -> ShowS
$cshowsPrec :: Int -> Repo -> ShowS
Show, Repo -> Repo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c== :: Repo -> Repo -> Bool
Eq, Eq Repo
Repo -> Repo -> Bool
Repo -> Repo -> Ordering
Repo -> Repo -> Repo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmax :: Repo -> Repo -> Repo
>= :: Repo -> Repo -> Bool
$c>= :: Repo -> Repo -> Bool
> :: Repo -> Repo -> Bool
$c> :: Repo -> Repo -> Bool
<= :: Repo -> Repo -> Bool
$c<= :: Repo -> Repo -> Bool
< :: Repo -> Repo -> Bool
$c< :: Repo -> Repo -> Bool
compare :: Repo -> Repo -> Ordering
$ccompare :: Repo -> Repo -> Ordering
Ord, forall x. Rep Repo x -> Repo
forall x. Repo -> Rep Repo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repo x -> Repo
$cfrom :: forall x. Repo -> Rep Repo x
Generic)
instance Binary Repo
instance Structured Repo
isRepoRemote :: Repo -> Bool
isRepoRemote :: Repo -> Bool
isRepoRemote RepoLocalNoIndex{} = Bool
False
isRepoRemote Repo
_ = Bool
True
maybeRepoRemote :: Repo -> Maybe RemoteRepo
maybeRepoRemote :: Repo -> Maybe RemoteRepo
maybeRepoRemote (RepoLocalNoIndex LocalRepo
_ FilePath
_localDir) = forall a. Maybe a
Nothing
maybeRepoRemote (RepoRemote RemoteRepo
r FilePath
_localDir) = forall a. a -> Maybe a
Just RemoteRepo
r
maybeRepoRemote (RepoSecure RemoteRepo
r FilePath
_localDir) = forall a. a -> Maybe a
Just RemoteRepo
r
repoName :: Repo -> RepoName
repoName :: Repo -> RepoName
repoName (RepoLocalNoIndex LocalRepo
r FilePath
_) = LocalRepo -> RepoName
localRepoName LocalRepo
r
repoName (RepoRemote RemoteRepo
r FilePath
_) = RemoteRepo -> RepoName
remoteRepoName RemoteRepo
r
repoName (RepoSecure RemoteRepo
r FilePath
_) = RemoteRepo -> RepoName
remoteRepoName RemoteRepo
r