IndexState.hs 5.21 KB
Newer Older
Oleg Grenrus's avatar
Oleg Grenrus committed
1 2 3 4 5 6 7 8
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.IndexUtils.IndexUtils
-- Copyright   :  (c) 2016 Herbert Valerio Riedel
-- License     :  BSD3
--
9 10
-- Package repositories index state.
--
Oleg Grenrus's avatar
Oleg Grenrus committed
11
module Distribution.Client.IndexUtils.IndexState (
12 13 14 15 16
    RepoIndexState(..),
    TotalIndexState,
    headTotalIndexState,
    makeTotalIndexState,
    lookupIndexState,
17
    insertIndexState,
Oleg Grenrus's avatar
Oleg Grenrus committed
18 19 20 21
) where

import Distribution.Client.Compat.Prelude
import Distribution.Client.IndexUtils.Timestamp (Timestamp)
Oleg Grenrus's avatar
Oleg Grenrus committed
22
import Distribution.Client.Types.RepoName       (RepoName (..))
Oleg Grenrus's avatar
Oleg Grenrus committed
23 24 25 26 27

import Distribution.FieldGrammar.Described
import Distribution.Parsec                 (Parsec (..))
import Distribution.Pretty                 (Pretty (..))

Oleg Grenrus's avatar
Oleg Grenrus committed
28
import qualified Data.Map.Strict                 as Map
Oleg Grenrus's avatar
Oleg Grenrus committed
29 30 31
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
-------------------------------------------------------------------------------
-- Total index state
-------------------------------------------------------------------------------

-- | Index state of multiple repositories
data TotalIndexState = TIS RepoIndexState (Map RepoName RepoIndexState)
  deriving (Eq, Show, Generic)

instance Binary TotalIndexState
instance Structured TotalIndexState
instance NFData TotalIndexState

instance Pretty TotalIndexState where
    pretty (TIS IndexStateHead m)
        | not (Map.null m)
        = Disp.hsep
            [ pretty rn <<>> Disp.colon <<>> pretty idx
            | (rn, idx) <- Map.toList m
            ]
    pretty (TIS def m) = foldl' go (pretty def) (Map.toList m) where
        go doc (rn, idx) = doc Disp.<+> pretty rn <<>> Disp.colon <<>> pretty idx

instance Parsec TotalIndexState where
    parsec = normalise . foldl' add headTotalIndexState <$> some (single0 <* P.spaces) where
        -- hard to do without try
        -- 2020-03-21T11:22:33Z looks like it begins with
        -- repository name 2020-03-21T11
        --
        -- To make this easy, we could forbid repository names starting with digit
        --
        single0 = P.try single1 <|> TokTimestamp <$> parsec
        single1 = do
            token <- P.munch1 (\c -> isAlphaNum c || c == '_' || c == '-' || c == '.')
            single2 token <|> single3 token

        single2 token = do
            _   <- P.char ':'
            idx <- parsec
            return (TokRepo (RepoName token) idx)

        single3 "HEAD" = return TokHead
        single3 token  = P.unexpected ("Repository " ++ token ++ " without index state (after comma)")

        add :: TotalIndexState -> Tok -> TotalIndexState
        add _           TokHead           = headTotalIndexState
        add _           (TokTimestamp ts) = TIS (IndexStateTime ts) Map.empty
        add (TIS def m) (TokRepo rn idx)  = TIS def (Map.insert rn idx m)

instance Described TotalIndexState where
    describe _ = REMunch1 RESpaces1 $ REUnion
        [ describe (Proxy :: Proxy RepoName) <> reChar ':' <> ris
        , ris
        ]
      where
        ris = describe (Proxy :: Proxy RepoIndexState)

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

-- | Remove non-default values from 'TotalIndexState'.
normalise :: TotalIndexState -> TotalIndexState
normalise (TIS def m) = TIS def (Map.filter (/= def) m)

-- | 'TotalIndexState' where all repositories are at @HEAD@ index state.
headTotalIndexState :: TotalIndexState
headTotalIndexState = TIS IndexStateHead Map.empty

-- | Create 'TotalIndexState'.
makeTotalIndexState :: RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
makeTotalIndexState def m = normalise (TIS def m)

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

110 111 112 113 114 115
-- | Insert a 'RepoIndexState' to 'TotalIndexState'.
insertIndexState :: RepoName -> RepoIndexState -> TotalIndexState -> TotalIndexState
insertIndexState rn idx (TIS def m)
    | idx == def = TIS def (Map.delete rn m)
    | otherwise  = TIS def (Map.insert rn idx m)

116 117 118 119
-------------------------------------------------------------------------------
-- Repository index state
-------------------------------------------------------------------------------

Oleg Grenrus's avatar
Oleg Grenrus committed
120
-- | Specification of the state of a specific repo package index
121 122 123 124
data RepoIndexState
    = IndexStateHead -- ^ Use all available entries
    | IndexStateTime !Timestamp -- ^ Use all entries that existed at the specified time
    deriving (Eq,Generic,Show)
Oleg Grenrus's avatar
Oleg Grenrus committed
125

126 127 128
instance Binary RepoIndexState
instance Structured RepoIndexState
instance NFData RepoIndexState
Oleg Grenrus's avatar
Oleg Grenrus committed
129

130
instance Pretty RepoIndexState where
Oleg Grenrus's avatar
Oleg Grenrus committed
131 132 133
    pretty IndexStateHead = Disp.text "HEAD"
    pretty (IndexStateTime ts) = pretty ts

134
instance Parsec RepoIndexState where
Oleg Grenrus's avatar
Oleg Grenrus committed
135 136 137 138
    parsec = parseHead <|> parseTime where
        parseHead = IndexStateHead <$ P.string "HEAD"
        parseTime = IndexStateTime <$> parsec

139
instance Described RepoIndexState where
Oleg Grenrus's avatar
Oleg Grenrus committed
140 141 142 143
    describe _ = REUnion
        [ "HEAD"
        , RENamed "timestamp" (describe (Proxy :: Proxy Timestamp))
        ]