{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Client.IndexUtils.ActiveRepos (
ActiveRepos (..),
defaultActiveRepos,
filterSkippedActiveRepos,
ActiveRepoEntry (..),
CombineStrategy (..),
organizeByRepos,
) where
import Distribution.Client.Compat.Prelude
import Distribution.Client.Types.RepoName (RepoName (..))
import Prelude ()
import Distribution.Parsec (parsecLeadingCommaNonEmpty)
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
newtype ActiveRepos = ActiveRepos [ActiveRepoEntry]
deriving (ActiveRepos -> ActiveRepos -> Bool
(ActiveRepos -> ActiveRepos -> Bool)
-> (ActiveRepos -> ActiveRepos -> Bool) -> Eq ActiveRepos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveRepos -> ActiveRepos -> Bool
$c/= :: ActiveRepos -> ActiveRepos -> Bool
== :: ActiveRepos -> ActiveRepos -> Bool
$c== :: ActiveRepos -> ActiveRepos -> Bool
Eq, Int -> ActiveRepos -> ShowS
[ActiveRepos] -> ShowS
ActiveRepos -> String
(Int -> ActiveRepos -> ShowS)
-> (ActiveRepos -> String)
-> ([ActiveRepos] -> ShowS)
-> Show ActiveRepos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveRepos] -> ShowS
$cshowList :: [ActiveRepos] -> ShowS
show :: ActiveRepos -> String
$cshow :: ActiveRepos -> String
showsPrec :: Int -> ActiveRepos -> ShowS
$cshowsPrec :: Int -> ActiveRepos -> ShowS
Show, (forall x. ActiveRepos -> Rep ActiveRepos x)
-> (forall x. Rep ActiveRepos x -> ActiveRepos)
-> Generic ActiveRepos
forall x. Rep ActiveRepos x -> ActiveRepos
forall x. ActiveRepos -> Rep ActiveRepos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActiveRepos x -> ActiveRepos
$cfrom :: forall x. ActiveRepos -> Rep ActiveRepos x
Generic)
defaultActiveRepos :: ActiveRepos
defaultActiveRepos :: ActiveRepos
defaultActiveRepos = [ActiveRepoEntry] -> ActiveRepos
ActiveRepos [ CombineStrategy -> ActiveRepoEntry
ActiveRepoRest CombineStrategy
CombineStrategyMerge ]
filterSkippedActiveRepos :: ActiveRepos -> ActiveRepos
filterSkippedActiveRepos :: ActiveRepos -> ActiveRepos
filterSkippedActiveRepos repos :: ActiveRepos
repos@(ActiveRepos [ActiveRepoEntry]
entries)
| (ActiveRepoEntry -> Bool) -> [ActiveRepoEntry] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ActiveRepoEntry -> Bool
isActiveRepoRest [ActiveRepoEntry]
entries = ActiveRepos
repos
| Bool
otherwise = [ActiveRepoEntry] -> ActiveRepos
ActiveRepos ((ActiveRepoEntry -> Bool) -> [ActiveRepoEntry] -> [ActiveRepoEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ActiveRepoEntry -> Bool
notSkipped [ActiveRepoEntry]
entries)
where
isActiveRepoRest :: ActiveRepoEntry -> Bool
isActiveRepoRest (ActiveRepoRest CombineStrategy
_) = Bool
True
isActiveRepoRest ActiveRepoEntry
_ = Bool
False
notSkipped :: ActiveRepoEntry -> Bool
notSkipped (ActiveRepo RepoName
_ CombineStrategy
CombineStrategySkip) = Bool
False
notSkipped ActiveRepoEntry
_ = Bool
True
instance Binary ActiveRepos
instance Structured ActiveRepos
instance NFData ActiveRepos
instance Pretty ActiveRepos where
pretty :: ActiveRepos -> Doc
pretty (ActiveRepos [])
= String -> Doc
Disp.text String
":none"
pretty (ActiveRepos [ActiveRepoEntry]
repos)
= [Doc] -> Doc
Disp.hsep
([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
Disp.punctuate Doc
Disp.comma
([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (ActiveRepoEntry -> Doc) -> [ActiveRepoEntry] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ActiveRepoEntry -> Doc
forall a. Pretty a => a -> Doc
pretty [ActiveRepoEntry]
repos
instance Parsec ActiveRepos where
parsec :: m ActiveRepos
parsec = [ActiveRepoEntry] -> ActiveRepos
ActiveRepos [] ActiveRepos -> m String -> m ActiveRepos
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m String -> m String
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
":none")
m ActiveRepos -> m ActiveRepos -> m ActiveRepos
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
NonEmpty ActiveRepoEntry
repos <- m ActiveRepoEntry -> m (NonEmpty ActiveRepoEntry)
forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m ActiveRepoEntry
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
ActiveRepos -> m ActiveRepos
forall (m :: * -> *) a. Monad m => a -> m a
return ([ActiveRepoEntry] -> ActiveRepos
ActiveRepos (NonEmpty ActiveRepoEntry -> [ActiveRepoEntry]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ActiveRepoEntry
repos))
data ActiveRepoEntry
= ActiveRepoRest CombineStrategy
| ActiveRepo RepoName CombineStrategy
deriving (ActiveRepoEntry -> ActiveRepoEntry -> Bool
(ActiveRepoEntry -> ActiveRepoEntry -> Bool)
-> (ActiveRepoEntry -> ActiveRepoEntry -> Bool)
-> Eq ActiveRepoEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveRepoEntry -> ActiveRepoEntry -> Bool
$c/= :: ActiveRepoEntry -> ActiveRepoEntry -> Bool
== :: ActiveRepoEntry -> ActiveRepoEntry -> Bool
$c== :: ActiveRepoEntry -> ActiveRepoEntry -> Bool
Eq, Int -> ActiveRepoEntry -> ShowS
[ActiveRepoEntry] -> ShowS
ActiveRepoEntry -> String
(Int -> ActiveRepoEntry -> ShowS)
-> (ActiveRepoEntry -> String)
-> ([ActiveRepoEntry] -> ShowS)
-> Show ActiveRepoEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveRepoEntry] -> ShowS
$cshowList :: [ActiveRepoEntry] -> ShowS
show :: ActiveRepoEntry -> String
$cshow :: ActiveRepoEntry -> String
showsPrec :: Int -> ActiveRepoEntry -> ShowS
$cshowsPrec :: Int -> ActiveRepoEntry -> ShowS
Show, (forall x. ActiveRepoEntry -> Rep ActiveRepoEntry x)
-> (forall x. Rep ActiveRepoEntry x -> ActiveRepoEntry)
-> Generic ActiveRepoEntry
forall x. Rep ActiveRepoEntry x -> ActiveRepoEntry
forall x. ActiveRepoEntry -> Rep ActiveRepoEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActiveRepoEntry x -> ActiveRepoEntry
$cfrom :: forall x. ActiveRepoEntry -> Rep ActiveRepoEntry x
Generic)
instance Binary ActiveRepoEntry
instance Structured ActiveRepoEntry
instance NFData ActiveRepoEntry
instance Pretty ActiveRepoEntry where
pretty :: ActiveRepoEntry -> Doc
pretty (ActiveRepoRest CombineStrategy
s) =
String -> Doc
Disp.text String
":rest" Doc -> Doc -> Doc
<<>> Doc
Disp.colon Doc -> Doc -> Doc
<<>> CombineStrategy -> Doc
forall a. Pretty a => a -> Doc
pretty CombineStrategy
s
pretty (ActiveRepo RepoName
r CombineStrategy
s) =
RepoName -> Doc
forall a. Pretty a => a -> Doc
pretty RepoName
r Doc -> Doc -> Doc
<<>> Doc
Disp.colon Doc -> Doc -> Doc
<<>> CombineStrategy -> Doc
forall a. Pretty a => a -> Doc
pretty CombineStrategy
s
instance Parsec ActiveRepoEntry where
parsec :: m ActiveRepoEntry
parsec = m ActiveRepoEntry
leadColon m ActiveRepoEntry -> m ActiveRepoEntry -> m ActiveRepoEntry
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ActiveRepoEntry
leadRepo where
leadColon :: m ActiveRepoEntry
leadColon = do
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
String
token <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlpha
case String
token of
String
"rest" -> CombineStrategy -> ActiveRepoEntry
ActiveRepoRest (CombineStrategy -> ActiveRepoEntry)
-> m CombineStrategy -> m ActiveRepoEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CombineStrategy
strategyP
String
"repo" -> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m Char -> m ActiveRepoEntry -> m ActiveRepoEntry
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ActiveRepoEntry
leadRepo
String
_ -> String -> m ActiveRepoEntry
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected (String -> m ActiveRepoEntry) -> String -> m ActiveRepoEntry
forall a b. (a -> b) -> a -> b
$ String
"Unknown active repository entry type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
token
leadRepo :: m ActiveRepoEntry
leadRepo = do
RepoName
r <- m RepoName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
CombineStrategy
s <- m CombineStrategy
strategyP
ActiveRepoEntry -> m ActiveRepoEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoName -> CombineStrategy -> ActiveRepoEntry
ActiveRepo RepoName
r CombineStrategy
s)
strategyP :: m CombineStrategy
strategyP = CombineStrategy -> m CombineStrategy -> m CombineStrategy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option CombineStrategy
CombineStrategyMerge (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m Char -> m CombineStrategy -> m CombineStrategy
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m CombineStrategy
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec)
data CombineStrategy
= CombineStrategySkip
| CombineStrategyMerge
| CombineStrategyOverride
deriving (CombineStrategy -> CombineStrategy -> Bool
(CombineStrategy -> CombineStrategy -> Bool)
-> (CombineStrategy -> CombineStrategy -> Bool)
-> Eq CombineStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CombineStrategy -> CombineStrategy -> Bool
$c/= :: CombineStrategy -> CombineStrategy -> Bool
== :: CombineStrategy -> CombineStrategy -> Bool
$c== :: CombineStrategy -> CombineStrategy -> Bool
Eq, Int -> CombineStrategy -> ShowS
[CombineStrategy] -> ShowS
CombineStrategy -> String
(Int -> CombineStrategy -> ShowS)
-> (CombineStrategy -> String)
-> ([CombineStrategy] -> ShowS)
-> Show CombineStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CombineStrategy] -> ShowS
$cshowList :: [CombineStrategy] -> ShowS
show :: CombineStrategy -> String
$cshow :: CombineStrategy -> String
showsPrec :: Int -> CombineStrategy -> ShowS
$cshowsPrec :: Int -> CombineStrategy -> ShowS
Show, Int -> CombineStrategy
CombineStrategy -> Int
CombineStrategy -> [CombineStrategy]
CombineStrategy -> CombineStrategy
CombineStrategy -> CombineStrategy -> [CombineStrategy]
CombineStrategy
-> CombineStrategy -> CombineStrategy -> [CombineStrategy]
(CombineStrategy -> CombineStrategy)
-> (CombineStrategy -> CombineStrategy)
-> (Int -> CombineStrategy)
-> (CombineStrategy -> Int)
-> (CombineStrategy -> [CombineStrategy])
-> (CombineStrategy -> CombineStrategy -> [CombineStrategy])
-> (CombineStrategy -> CombineStrategy -> [CombineStrategy])
-> (CombineStrategy
-> CombineStrategy -> CombineStrategy -> [CombineStrategy])
-> Enum CombineStrategy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CombineStrategy
-> CombineStrategy -> CombineStrategy -> [CombineStrategy]
$cenumFromThenTo :: CombineStrategy
-> CombineStrategy -> CombineStrategy -> [CombineStrategy]
enumFromTo :: CombineStrategy -> CombineStrategy -> [CombineStrategy]
$cenumFromTo :: CombineStrategy -> CombineStrategy -> [CombineStrategy]
enumFromThen :: CombineStrategy -> CombineStrategy -> [CombineStrategy]
$cenumFromThen :: CombineStrategy -> CombineStrategy -> [CombineStrategy]
enumFrom :: CombineStrategy -> [CombineStrategy]
$cenumFrom :: CombineStrategy -> [CombineStrategy]
fromEnum :: CombineStrategy -> Int
$cfromEnum :: CombineStrategy -> Int
toEnum :: Int -> CombineStrategy
$ctoEnum :: Int -> CombineStrategy
pred :: CombineStrategy -> CombineStrategy
$cpred :: CombineStrategy -> CombineStrategy
succ :: CombineStrategy -> CombineStrategy
$csucc :: CombineStrategy -> CombineStrategy
Enum, CombineStrategy
CombineStrategy -> CombineStrategy -> Bounded CombineStrategy
forall a. a -> a -> Bounded a
maxBound :: CombineStrategy
$cmaxBound :: CombineStrategy
minBound :: CombineStrategy
$cminBound :: CombineStrategy
Bounded, (forall x. CombineStrategy -> Rep CombineStrategy x)
-> (forall x. Rep CombineStrategy x -> CombineStrategy)
-> Generic CombineStrategy
forall x. Rep CombineStrategy x -> CombineStrategy
forall x. CombineStrategy -> Rep CombineStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CombineStrategy x -> CombineStrategy
$cfrom :: forall x. CombineStrategy -> Rep CombineStrategy x
Generic)
instance Binary CombineStrategy
instance Structured CombineStrategy
instance NFData CombineStrategy
instance Pretty CombineStrategy where
pretty :: CombineStrategy -> Doc
pretty CombineStrategy
CombineStrategySkip = String -> Doc
Disp.text String
"skip"
pretty CombineStrategy
CombineStrategyMerge = String -> Doc
Disp.text String
"merge"
pretty CombineStrategy
CombineStrategyOverride = String -> Doc
Disp.text String
"override"
instance Parsec CombineStrategy where
parsec :: m CombineStrategy
parsec = [m CombineStrategy] -> m CombineStrategy
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
[ CombineStrategy
CombineStrategySkip CombineStrategy -> m String -> m CombineStrategy
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"skip"
, CombineStrategy
CombineStrategyMerge CombineStrategy -> m String -> m CombineStrategy
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"merge"
, CombineStrategy
CombineStrategyOverride CombineStrategy -> m String -> m CombineStrategy
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"override"
]
organizeByRepos
:: forall a. ActiveRepos
-> (a -> RepoName)
-> [a]
-> Either String [(a, CombineStrategy)]
organizeByRepos :: ActiveRepos
-> (a -> RepoName) -> [a] -> Either String [(a, CombineStrategy)]
organizeByRepos (ActiveRepos [ActiveRepoEntry]
xs0) a -> RepoName
sel [a]
ys0 =
let ([a]
rest, Either String [(a, CombineStrategy)]
result) = case [a]
-> [ActiveRepoEntry]
-> [a]
-> Either String ([a], [(a, CombineStrategy)])
go [a]
rest [ActiveRepoEntry]
xs0 [a]
ys0 of
Right ([a]
rest', [(a, CombineStrategy)]
result') -> ([a]
rest', [(a, CombineStrategy)] -> Either String [(a, CombineStrategy)]
forall a b. b -> Either a b
Right [(a, CombineStrategy)]
result')
Left String
err -> ([], String -> Either String [(a, CombineStrategy)]
forall a b. a -> Either a b
Left String
err)
in Either String [(a, CombineStrategy)]
result
where
go :: [a] -> [ActiveRepoEntry] -> [a] -> Either String ([a], [(a, CombineStrategy)])
go :: [a]
-> [ActiveRepoEntry]
-> [a]
-> Either String ([a], [(a, CombineStrategy)])
go [a]
_rest [] [a]
ys = ([a], [(a, CombineStrategy)])
-> Either String ([a], [(a, CombineStrategy)])
forall a b. b -> Either a b
Right ([a]
ys, [])
go [a]
rest (ActiveRepoRest CombineStrategy
s : [ActiveRepoEntry]
xs) [a]
ys =
[a]
-> [ActiveRepoEntry]
-> [a]
-> Either String ([a], [(a, CombineStrategy)])
go [a]
rest [ActiveRepoEntry]
xs [a]
ys Either String ([a], [(a, CombineStrategy)])
-> (([a], [(a, CombineStrategy)]) -> ([a], [(a, CombineStrategy)]))
-> Either String ([a], [(a, CombineStrategy)])
forall err s b c.
Either err ([s], b)
-> (([s], b) -> ([s], c)) -> Either err ([s], c)
<&> \([a]
rest', [(a, CombineStrategy)]
result) ->
([a]
rest', (a -> (a, CombineStrategy)) -> [a] -> [(a, CombineStrategy)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x, CombineStrategy
s)) [a]
rest [(a, CombineStrategy)]
-> [(a, CombineStrategy)] -> [(a, CombineStrategy)]
forall a. [a] -> [a] -> [a]
++ [(a, CombineStrategy)]
result)
go [a]
rest (ActiveRepo RepoName
r CombineStrategy
s : [ActiveRepoEntry]
xs) [a]
ys = do
(a
z, [a]
zs) <- RepoName -> [a] -> Either String (a, [a])
extract RepoName
r [a]
ys
[a]
-> [ActiveRepoEntry]
-> [a]
-> Either String ([a], [(a, CombineStrategy)])
go [a]
rest [ActiveRepoEntry]
xs [a]
zs Either String ([a], [(a, CombineStrategy)])
-> (([a], [(a, CombineStrategy)]) -> ([a], [(a, CombineStrategy)]))
-> Either String ([a], [(a, CombineStrategy)])
forall err s b c.
Either err ([s], b)
-> (([s], b) -> ([s], c)) -> Either err ([s], c)
<&> \([a]
rest', [(a, CombineStrategy)]
result) ->
([a]
rest', (a
z, CombineStrategy
s) (a, CombineStrategy)
-> [(a, CombineStrategy)] -> [(a, CombineStrategy)]
forall a. a -> [a] -> [a]
: [(a, CombineStrategy)]
result)
extract :: RepoName -> [a] -> Either String (a, [a])
extract :: RepoName -> [a] -> Either String (a, [a])
extract RepoName
r = ([a] -> [a]) -> [a] -> Either String (a, [a])
forall c. ([a] -> c) -> [a] -> Either String (a, c)
loop [a] -> [a]
forall a. a -> a
id where
loop :: ([a] -> c) -> [a] -> Either String (a, c)
loop [a] -> c
_acc [] = String -> Either String (a, c)
forall a b. a -> Either a b
Left (String -> Either String (a, c)) -> String -> Either String (a, c)
forall a b. (a -> b) -> a -> b
$ String
"no repository provided " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RepoName -> String
forall a. Pretty a => a -> String
prettyShow RepoName
r
loop [a] -> c
acc (a
x:[a]
xs)
| a -> RepoName
sel a
x RepoName -> RepoName -> Bool
forall a. Eq a => a -> a -> Bool
== RepoName
r = (a, c) -> Either String (a, c)
forall a b. b -> Either a b
Right (a
x, [a] -> c
acc [a]
xs)
| Bool
otherwise = ([a] -> c) -> [a] -> Either String (a, c)
loop ([a] -> c
acc ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
xs
(<&>)
:: Either err ([s], b)
-> (([s], b) -> ([s], c))
-> Either err ([s], c)
<&> :: Either err ([s], b)
-> (([s], b) -> ([s], c)) -> Either err ([s], c)
(<&>) = ((([s], b) -> ([s], c))
-> Either err ([s], b) -> Either err ([s], c))
-> Either err ([s], b)
-> (([s], b) -> ([s], c))
-> Either err ([s], c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([s], b) -> ([s], c))
-> Either err ([s], b) -> Either err ([s], c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap