{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Client.IndexUtils.IndexUtils
-- Copyright   :  (c) 2016 Herbert Valerio Riedel
-- License     :  BSD3
--
-- Package repositories index state.
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

-- $setup
-- >>> import Distribution.Parsec

-------------------------------------------------------------------------------
-- Total index state
-------------------------------------------------------------------------------

-- | Index state of multiple repositories
data TotalIndexState = TIS RepoIndexState (Map RepoName RepoIndexState)
  deriving (TotalIndexState -> TotalIndexState -> Bool
(TotalIndexState -> TotalIndexState -> Bool)
-> (TotalIndexState -> TotalIndexState -> Bool)
-> Eq TotalIndexState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TotalIndexState -> TotalIndexState -> Bool
== :: TotalIndexState -> TotalIndexState -> Bool
$c/= :: TotalIndexState -> TotalIndexState -> Bool
/= :: TotalIndexState -> TotalIndexState -> Bool
Eq, Int -> TotalIndexState -> ShowS
[TotalIndexState] -> ShowS
TotalIndexState -> String
(Int -> TotalIndexState -> ShowS)
-> (TotalIndexState -> String)
-> ([TotalIndexState] -> ShowS)
-> Show TotalIndexState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TotalIndexState -> ShowS
showsPrec :: Int -> TotalIndexState -> ShowS
$cshow :: TotalIndexState -> String
show :: TotalIndexState -> String
$cshowList :: [TotalIndexState] -> ShowS
showList :: [TotalIndexState] -> ShowS
Show, (forall x. TotalIndexState -> Rep TotalIndexState x)
-> (forall x. Rep TotalIndexState x -> TotalIndexState)
-> Generic TotalIndexState
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
$cfrom :: forall x. TotalIndexState -> Rep TotalIndexState x
from :: forall x. TotalIndexState -> Rep TotalIndexState x
$cto :: forall x. Rep TotalIndexState x -> TotalIndexState
to :: forall x. Rep TotalIndexState x -> TotalIndexState
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 (Map RepoName RepoIndexState -> Bool
forall k a. Map k a -> Bool
Map.null Map RepoName RepoIndexState
m) =
        [Doc] -> Doc
Disp.hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
          Doc -> [Doc] -> [Doc]
Disp.punctuate
            Doc
Disp.comma
            [ RepoName -> Doc
forall a. Pretty a => a -> Doc
pretty RepoName
rn Doc -> Doc -> Doc
Disp.<+> RepoIndexState -> Doc
forall a. Pretty a => a -> Doc
pretty RepoIndexState
idx
            | (RepoName
rn, RepoIndexState
idx) <- Map RepoName RepoIndexState -> [(RepoName, RepoIndexState)]
forall k a. Map k a -> [(k, a)]
Map.toList Map RepoName RepoIndexState
m
            ]
  pretty (TIS RepoIndexState
def Map RepoName RepoIndexState
m) = (Doc -> (RepoName, RepoIndexState) -> Doc)
-> Doc -> [(RepoName, RepoIndexState)] -> Doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc -> (RepoName, RepoIndexState) -> Doc
forall {a} {a}. (Pretty a, Pretty a) => Doc -> (a, a) -> Doc
go (RepoIndexState -> Doc
forall a. Pretty a => a -> Doc
pretty RepoIndexState
def) (Map RepoName RepoIndexState -> [(RepoName, RepoIndexState)]
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.<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
rn Doc -> Doc -> Doc
Disp.<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
idx

-- |
--
-- >>> simpleParsec "HEAD" :: Maybe TotalIndexState
-- Just (TIS IndexStateHead (fromList []))
--
-- >>> simpleParsec "" :: Maybe TotalIndexState
-- Nothing
--
-- >>> simpleParsec "hackage.haskell.org HEAD" :: Maybe TotalIndexState
-- Just (TIS IndexStateHead (fromList []))
--
-- >>> simpleParsec "2020-02-04T12:34:56Z, hackage.haskell.org HEAD" :: Maybe TotalIndexState
-- Just (TIS (IndexStateTime (TS 1580819696)) (fromList [(RepoName {unRepoName = "hackage.haskell.org"},IndexStateHead)]))
--
-- >>> simpleParsec "hackage.haskell.org 2020-02-04T12:34:56Z" :: Maybe TotalIndexState
-- Just (TIS IndexStateHead (fromList [(RepoName {unRepoName = "hackage.haskell.org"},IndexStateTime (TS 1580819696))]))
instance Parsec TotalIndexState where
  parsec :: forall (m :: * -> *). CabalParsing m => m TotalIndexState
parsec = TotalIndexState -> TotalIndexState
normalise (TotalIndexState -> TotalIndexState)
-> (NonEmpty Tok -> TotalIndexState)
-> NonEmpty Tok
-> TotalIndexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TotalIndexState -> Tok -> TotalIndexState)
-> TotalIndexState -> NonEmpty Tok -> TotalIndexState
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TotalIndexState -> Tok -> TotalIndexState
add TotalIndexState
headTotalIndexState (NonEmpty Tok -> TotalIndexState)
-> m (NonEmpty Tok) -> m TotalIndexState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Tok -> m (NonEmpty Tok)
forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m Tok
single0
    where
      single0 :: m Tok
single0 = m Tok
startsWithRepoName m Tok -> m Tok -> m Tok
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Timestamp -> Tok
TokTimestamp (Timestamp -> Tok) -> m Timestamp -> m Tok
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Timestamp
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Timestamp
parsec
      startsWithRepoName :: m Tok
startsWithRepoName = do
        RepoName
reponame <- m RepoName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RepoName
parsec
        -- the "HEAD" is technically a valid reponame...
        if RepoName
reponame RepoName -> RepoName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> RepoName
RepoName String
"HEAD"
          then Tok -> m Tok
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Tok
TokHead
          else do
            m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
            RepoName -> RepoIndexState -> Tok
TokRepo RepoName
reponame (RepoIndexState -> Tok) -> m RepoIndexState -> m Tok
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RepoIndexState
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RepoIndexState
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) Map RepoName RepoIndexState
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 (RepoName
-> RepoIndexState
-> Map RepoName RepoIndexState
-> Map RepoName RepoIndexState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RepoName
rn RepoIndexState
idx Map RepoName RepoIndexState
m)

-- used in Parsec TotalIndexState implementation
data Tok
  = TokRepo RepoName RepoIndexState
  | TokTimestamp Timestamp
  | TokHead

-- | Remove non-default values from 'TotalIndexState'.
normalise :: TotalIndexState -> TotalIndexState
normalise :: TotalIndexState -> TotalIndexState
normalise (TIS RepoIndexState
def Map RepoName RepoIndexState
m) = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def ((RepoIndexState -> Bool)
-> Map RepoName RepoIndexState -> Map RepoName RepoIndexState
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (RepoIndexState -> RepoIndexState -> Bool
forall a. Eq a => a -> a -> Bool
/= RepoIndexState
def) Map RepoName RepoIndexState
m)

-- | 'TotalIndexState' where all repositories are at @HEAD@ index state.
headTotalIndexState :: TotalIndexState
headTotalIndexState :: TotalIndexState
headTotalIndexState = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
IndexStateHead Map RepoName RepoIndexState
forall k a. Map k a
Map.empty

-- | Create 'TotalIndexState'.
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)

-- | Lookup a 'RepoIndexState' for an individual repository from 'TotalIndexState'.
lookupIndexState :: RepoName -> TotalIndexState -> RepoIndexState
lookupIndexState :: RepoName -> TotalIndexState -> RepoIndexState
lookupIndexState RepoName
rn (TIS RepoIndexState
def Map RepoName RepoIndexState
m) = RepoIndexState
-> RepoName -> Map RepoName RepoIndexState -> RepoIndexState
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault RepoIndexState
def RepoName
rn Map RepoName RepoIndexState
m

-- | Insert a 'RepoIndexState' to 'TotalIndexState'.
insertIndexState :: RepoName -> RepoIndexState -> TotalIndexState -> TotalIndexState
insertIndexState :: RepoName -> RepoIndexState -> TotalIndexState -> TotalIndexState
insertIndexState RepoName
rn RepoIndexState
idx (TIS RepoIndexState
def Map RepoName RepoIndexState
m)
  | RepoIndexState
idx RepoIndexState -> RepoIndexState -> Bool
forall a. Eq a => a -> a -> Bool
== RepoIndexState
def = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
def (RepoName
-> Map RepoName RepoIndexState -> Map RepoName RepoIndexState
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 (RepoName
-> RepoIndexState
-> Map RepoName RepoIndexState
-> Map RepoName RepoIndexState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RepoName
rn RepoIndexState
idx Map RepoName RepoIndexState
m)

-------------------------------------------------------------------------------
-- Repository index state
-------------------------------------------------------------------------------

-- | Specification of the state of a specific repo package index
data RepoIndexState
  = -- | Use all available entries
    IndexStateHead
  | -- | Use all entries that existed at the specified time
    IndexStateTime !Timestamp
  deriving (RepoIndexState -> RepoIndexState -> Bool
(RepoIndexState -> RepoIndexState -> Bool)
-> (RepoIndexState -> RepoIndexState -> Bool) -> Eq RepoIndexState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoIndexState -> RepoIndexState -> Bool
== :: RepoIndexState -> RepoIndexState -> Bool
$c/= :: RepoIndexState -> RepoIndexState -> Bool
/= :: RepoIndexState -> RepoIndexState -> Bool
Eq, (forall x. RepoIndexState -> Rep RepoIndexState x)
-> (forall x. Rep RepoIndexState x -> RepoIndexState)
-> Generic RepoIndexState
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
$cfrom :: forall x. RepoIndexState -> Rep RepoIndexState x
from :: forall x. RepoIndexState -> Rep RepoIndexState x
$cto :: forall x. Rep RepoIndexState x -> RepoIndexState
to :: forall x. Rep RepoIndexState x -> RepoIndexState
Generic, Int -> RepoIndexState -> ShowS
[RepoIndexState] -> ShowS
RepoIndexState -> String
(Int -> RepoIndexState -> ShowS)
-> (RepoIndexState -> String)
-> ([RepoIndexState] -> ShowS)
-> Show RepoIndexState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoIndexState -> ShowS
showsPrec :: Int -> RepoIndexState -> ShowS
$cshow :: RepoIndexState -> String
show :: RepoIndexState -> String
$cshowList :: [RepoIndexState] -> ShowS
showList :: [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) = Timestamp -> Doc
forall a. Pretty a => a -> Doc
pretty Timestamp
ts

instance Parsec RepoIndexState where
  parsec :: forall (m :: * -> *). CabalParsing m => m RepoIndexState
parsec = m RepoIndexState
parseHead m RepoIndexState -> m RepoIndexState -> m RepoIndexState
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m RepoIndexState
parseTime
    where
      parseHead :: m RepoIndexState
parseHead = RepoIndexState
IndexStateHead RepoIndexState -> m String -> m RepoIndexState
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"HEAD"
      parseTime :: m RepoIndexState
parseTime = Timestamp -> RepoIndexState
IndexStateTime (Timestamp -> RepoIndexState) -> m Timestamp -> m RepoIndexState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Timestamp
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Timestamp
parsec