{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Client.IndexUtils.IndexState (
RepoIndexState(..),
TotalIndexState,
headTotalIndexState,
makeTotalIndexState,
lookupIndexState,
insertIndexState,
) where
import Distribution.Client.Compat.Prelude
import Distribution.Client.IndexUtils.Timestamp (Timestamp)
import Distribution.Client.Types.RepoName (RepoName (..))
import Distribution.Parsec (parsecLeadingCommaNonEmpty)
import qualified Data.Map.Strict as Map
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
data TotalIndexState = TIS RepoIndexState (Map RepoName RepoIndexState)
deriving (TotalIndexState -> TotalIndexState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TotalIndexState -> TotalIndexState -> Bool
$c/= :: TotalIndexState -> TotalIndexState -> Bool
== :: TotalIndexState -> TotalIndexState -> Bool
$c== :: TotalIndexState -> TotalIndexState -> Bool
Eq, Int -> TotalIndexState -> ShowS
[TotalIndexState] -> ShowS
TotalIndexState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TotalIndexState] -> ShowS
$cshowList :: [TotalIndexState] -> ShowS
show :: TotalIndexState -> String
$cshow :: TotalIndexState -> String
showsPrec :: Int -> TotalIndexState -> ShowS
$cshowsPrec :: Int -> TotalIndexState -> ShowS
Show, forall x. Rep TotalIndexState x -> TotalIndexState
forall x. TotalIndexState -> Rep TotalIndexState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TotalIndexState x -> TotalIndexState
$cfrom :: forall x. TotalIndexState -> Rep TotalIndexState x
Generic)
instance Binary TotalIndexState
instance Structured TotalIndexState
instance NFData TotalIndexState
instance Pretty TotalIndexState where
pretty :: TotalIndexState -> Doc
pretty (TIS RepoIndexState
IndexStateHead Map RepoName RepoIndexState
m)
| Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null Map RepoName RepoIndexState
m)
= [Doc] -> Doc
Disp.hsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
Disp.punctuate Doc
Disp.comma
[ forall a. Pretty a => a -> Doc
pretty RepoName
rn Doc -> Doc -> Doc
Disp.<+> forall a. Pretty a => a -> Doc
pretty RepoIndexState
idx
| (RepoName
rn, RepoIndexState
idx) <- forall k a. Map k a -> [(k, a)]
Map.toList Map RepoName RepoIndexState
m
]
pretty (TIS RepoIndexState
def Map RepoName RepoIndexState
m) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a}. (Pretty a, Pretty a) => Doc -> (a, a) -> Doc
go (forall a. Pretty a => a -> Doc
pretty RepoIndexState
def) (forall k a. Map k a -> [(k, a)]
Map.toList Map RepoName RepoIndexState
m) where
go :: Doc -> (a, a) -> Doc
go Doc
doc (a
rn, a
idx) = Doc
doc Doc -> Doc -> Doc
<<>> Doc
Disp.comma Doc -> Doc -> Doc
Disp.<+> forall a. Pretty a => a -> Doc
pretty a
rn Doc -> Doc -> Doc
Disp.<+> forall a. Pretty a => a -> Doc
pretty a
idx
instance Parsec TotalIndexState where
parsec :: forall (m :: * -> *). CabalParsing m => m TotalIndexState
parsec = TotalIndexState -> TotalIndexState
normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TotalIndexState -> Tok -> TotalIndexState
add TotalIndexState
headTotalIndexState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m Tok
single0 where
single0 :: m Tok
single0 = m Tok
startsWithRepoName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Timestamp -> Tok
TokTimestamp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
startsWithRepoName :: m Tok
startsWithRepoName = do
RepoName
reponame <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
if RepoName
reponame forall a. Eq a => a -> a -> Bool
== String -> RepoName
RepoName String
"HEAD"
then forall (m :: * -> *) a. Monad m => a -> m a
return Tok
TokHead
else do
forall (m :: * -> *). CharParsing m => m ()
P.spaces
RepoName -> RepoIndexState -> Tok
TokRepo RepoName
reponame forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
add :: TotalIndexState -> Tok -> TotalIndexState
add :: TotalIndexState -> Tok -> TotalIndexState
add TotalIndexState
_ Tok
TokHead = TotalIndexState
headTotalIndexState
add TotalIndexState
_ (TokTimestamp Timestamp
ts) = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS (Timestamp -> RepoIndexState
IndexStateTime Timestamp
ts) forall k a. Map k a
Map.empty
add (TIS RepoIndexState
def Map RepoName RepoIndexState
m) (TokRepo RepoName
rn RepoIndexState
idx) = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RepoName
rn RepoIndexState
idx Map RepoName RepoIndexState
m)
data Tok
= TokRepo RepoName RepoIndexState
| TokTimestamp Timestamp
| TokHead
normalise :: TotalIndexState -> TotalIndexState
normalise :: TotalIndexState -> TotalIndexState
normalise (TIS RepoIndexState
def Map RepoName RepoIndexState
m) = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Eq a => a -> a -> Bool
/= RepoIndexState
def) Map RepoName RepoIndexState
m)
headTotalIndexState :: TotalIndexState
headTotalIndexState :: TotalIndexState
headTotalIndexState = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
IndexStateHead forall k a. Map k a
Map.empty
makeTotalIndexState :: RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
makeTotalIndexState :: RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
makeTotalIndexState RepoIndexState
def Map RepoName RepoIndexState
m = TotalIndexState -> TotalIndexState
normalise (RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def Map RepoName RepoIndexState
m)
lookupIndexState :: RepoName -> TotalIndexState -> RepoIndexState
lookupIndexState :: RepoName -> TotalIndexState -> RepoIndexState
lookupIndexState RepoName
rn (TIS RepoIndexState
def Map RepoName RepoIndexState
m) = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault RepoIndexState
def RepoName
rn Map RepoName RepoIndexState
m
insertIndexState :: RepoName -> RepoIndexState -> TotalIndexState -> TotalIndexState
insertIndexState :: RepoName -> RepoIndexState -> TotalIndexState -> TotalIndexState
insertIndexState RepoName
rn RepoIndexState
idx (TIS RepoIndexState
def Map RepoName RepoIndexState
m)
| RepoIndexState
idx forall a. Eq a => a -> a -> Bool
== RepoIndexState
def = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete RepoName
rn Map RepoName RepoIndexState
m)
| Bool
otherwise = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RepoName
rn RepoIndexState
idx Map RepoName RepoIndexState
m)
data RepoIndexState
= IndexStateHead
| IndexStateTime !Timestamp
deriving (RepoIndexState -> RepoIndexState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoIndexState -> RepoIndexState -> Bool
$c/= :: RepoIndexState -> RepoIndexState -> Bool
== :: RepoIndexState -> RepoIndexState -> Bool
$c== :: RepoIndexState -> RepoIndexState -> Bool
Eq,forall x. Rep RepoIndexState x -> RepoIndexState
forall x. RepoIndexState -> Rep RepoIndexState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoIndexState x -> RepoIndexState
$cfrom :: forall x. RepoIndexState -> Rep RepoIndexState x
Generic,Int -> RepoIndexState -> ShowS
[RepoIndexState] -> ShowS
RepoIndexState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoIndexState] -> ShowS
$cshowList :: [RepoIndexState] -> ShowS
show :: RepoIndexState -> String
$cshow :: RepoIndexState -> String
showsPrec :: Int -> RepoIndexState -> ShowS
$cshowsPrec :: Int -> RepoIndexState -> ShowS
Show)
instance Binary RepoIndexState
instance Structured RepoIndexState
instance NFData RepoIndexState
instance Pretty RepoIndexState where
pretty :: RepoIndexState -> Doc
pretty RepoIndexState
IndexStateHead = String -> Doc
Disp.text String
"HEAD"
pretty (IndexStateTime Timestamp
ts) = forall a. Pretty a => a -> Doc
pretty Timestamp
ts
instance Parsec RepoIndexState where
parsec :: forall (m :: * -> *). CabalParsing m => m RepoIndexState
parsec = m RepoIndexState
parseHead forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m RepoIndexState
parseTime where
parseHead :: m RepoIndexState
parseHead = RepoIndexState
IndexStateHead forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"HEAD"
parseTime :: m RepoIndexState
parseTime = Timestamp -> RepoIndexState
IndexStateTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec