{-# 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
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

-- |
--
-- >>> 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 "hackage.haskell.org",IndexStateHead)]))
--
-- >>> simpleParsec "hackage.haskell.org 2020-02-04T12:34:56Z" :: Maybe TotalIndexState
-- Just (TIS IndexStateHead (fromList [(RepoName "hackage.haskell.org",IndexStateTime (TS 1580819696))]))
--
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
            -- the "HEAD" is technically a valid reponame...
            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)

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

-- | 'TotalIndexState' where all repositories are at @HEAD@ index state.
headTotalIndexState :: TotalIndexState
headTotalIndexState :: TotalIndexState
headTotalIndexState = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
TIS RepoIndexState
IndexStateHead 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) = 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 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)

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

-- | Specification of the state of a specific repo package index
data RepoIndexState
    = IndexStateHead -- ^ Use all available entries
    | IndexStateTime !Timestamp -- ^ Use all entries that existed at the specified time
    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