Cabal-syntax/src/Distribution/Types/SourceRepo.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 module Distribution.Types.SourceRepo
   5   ( SourceRepo (..)
   6   , RepoKind (..)
   7   , RepoType (..)
   8   , KnownRepoType (..)
   9   , knownRepoTypes
  10   , emptySourceRepo
  11   , classifyRepoType
  12   , classifyRepoKind
  13   ) where
  14
  15 import Distribution.Compat.Prelude
  16 import Prelude ()
  17
  18 import Distribution.Utils.Generic (lowercase)
  19
  20 import Distribution.Parsec
  21 import Distribution.Pretty
  22
  23 import qualified Data.Map.Strict as M
  24 import qualified Distribution.Compat.CharParsing as P
  25 import qualified Text.PrettyPrint as Disp
  26
  27 -- ------------------------------------------------------------
  28
  29 -- * Source repos
  30
  31 -- ------------------------------------------------------------
  32
  33 -- | Information about the source revision control system for a package.
  34 --
  35 -- When specifying a repo it is useful to know the meaning or intention of the
  36 -- information as doing so enables automation. There are two obvious common
  37 -- purposes: one is to find the repo for the latest development version, the
  38 -- other is to find the repo for this specific release. The 'ReopKind'
  39 -- specifies which one we mean (or another custom one).
  40 --
  41 -- A package can specify one or the other kind or both. Most will specify just
  42 -- a head repo but some may want to specify a repo to reconstruct the sources
  43 -- for this package release.
  44 --
  45 -- The required information is the 'RepoType' which tells us if it's using
  46 -- 'Darcs', 'Git' for example. The 'repoLocation' and other details are
  47 -- interpreted according to the repo type.
  48 data SourceRepo = SourceRepo
  49   { repoKind :: RepoKind
  50   -- ^ The kind of repo. This field is required.
  51   , repoType :: Maybe RepoType
  52   -- ^ The type of the source repository system for this repo, eg 'Darcs' or
  53   -- 'Git'. This field is required.
  54   , repoLocation :: Maybe String
  55   -- ^ The location of the repository. For most 'RepoType's this is a URL.
  56   -- This field is required.
  57   , repoModule :: Maybe String
  58   -- ^ 'CVS' can put multiple \"modules\" on one server and requires a
  59   -- module name in addition to the location to identify a particular repo.
  60   -- Logically this is part of the location but unfortunately has to be
  61   -- specified separately. This field is required for the 'CVS' 'RepoType' and
  62   -- should not be given otherwise.
  63   , repoBranch :: Maybe String
  64   -- ^ The name or identifier of the branch, if any. Many source control
  65   -- systems have the notion of multiple branches in a repo that exist in the
  66   -- same location. For example 'Git' and 'CVS' use this while systems like
  67   -- 'Darcs' use different locations for different branches. This field is
  68   -- optional but should be used if necessary to identify the sources,
  69   -- especially for the 'RepoThis' repo kind.
  70   , repoTag :: Maybe String
  71   -- ^ The tag identify a particular state of the repository. This should be
  72   -- given for the 'RepoThis' repo kind and not for 'RepoHead' kind.
  73   , repoSubdir :: Maybe FilePath
  74   -- ^ Some repositories contain multiple projects in different subdirectories
  75   -- This field specifies the subdirectory where this packages sources can be
  76   -- found, eg the subdirectory containing the @.cabal@ file. It is interpreted
  77   -- relative to the root of the repository. This field is optional. If not
  78   -- given the default is \".\" ie no subdirectory.
  79   }
  80   deriving (Eq, Ord, Generic, Read, Show, Typeable, Data)
  81
  82 emptySourceRepo :: RepoKind -> SourceRepo
  83 emptySourceRepo kind =
  84   SourceRepo
  85     { repoKind = kind
  86     , repoType = Nothing
  87     , repoLocation = Nothing
  88     , repoModule = Nothing
  89     , repoBranch = Nothing
  90     , repoTag = Nothing
  91     , repoSubdir = Nothing
  92     }
  93
  94 instance Binary SourceRepo
  95 instance Structured SourceRepo
  96 instance NFData SourceRepo where rnf = genericRnf
  97
  98 -- | What this repo info is for, what it represents.
  99 data RepoKind
 100   = -- | The repository for the \"head\" or development version of the project.
 101     -- This repo is where we should track the latest development activity or
 102     -- the usual repo people should get to contribute patches.
 103     RepoHead
 104   | -- | The repository containing the sources for this exact package version
 105     -- or release. For this kind of repo a tag should be given to give enough
 106     -- information to re-create the exact sources.
 107     RepoThis
 108   | RepoKindUnknown String
 109   deriving (Eq, Generic, Ord, Read, Show, Typeable, Data)
 110
 111 instance Binary RepoKind
 112 instance Structured RepoKind
 113 instance NFData RepoKind where rnf = genericRnf
 114
 115 -- | An enumeration of common source control systems. The fields used in the
 116 -- 'SourceRepo' depend on the type of repo. The tools and methods used to
 117 -- obtain and track the repo depend on the repo type.
 118 data KnownRepoType
 119   = Darcs
 120   | Git
 121   | SVN
 122   | CVS
 123   | Mercurial
 124   | GnuArch
 125   | Bazaar
 126   | Monotone
 127   | -- | @since 3.4.0.0
 128     Pijul
 129   deriving (Eq, Generic, Ord, Read, Show, Typeable, Data, Enum, Bounded)
 130
 131 instance Binary KnownRepoType
 132 instance Structured KnownRepoType
 133 instance NFData KnownRepoType where rnf = genericRnf
 134
 135 instance Parsec KnownRepoType where
 136   parsec = do
 137     str <- P.munch1 isIdent
 138     maybe
 139       (P.unexpected $ "Could not parse KnownRepoType from " ++ str)
 140       return
 141       (M.lookup str knownRepoTypeMap)
 142
 143 instance Pretty KnownRepoType where
 144   pretty = Disp.text . lowercase . show
 145
 146 data RepoType
 147   = KnownRepoType KnownRepoType
 148   | OtherRepoType String
 149   deriving (Eq, Generic, Ord, Read, Show, Typeable, Data)
 150
 151 instance Binary RepoType
 152 instance Structured RepoType
 153 instance NFData RepoType where rnf = genericRnf
 154
 155 knownRepoTypes :: [KnownRepoType]
 156 knownRepoTypes = [minBound .. maxBound]
 157
 158 repoTypeAliases :: KnownRepoType -> [String]
 159 repoTypeAliases Bazaar = ["bzr"]
 160 repoTypeAliases Mercurial = ["hg"]
 161 repoTypeAliases GnuArch = ["arch"]
 162 repoTypeAliases _ = []
 163
 164 instance Pretty RepoKind where
 165   pretty RepoHead = Disp.text "head"
 166   pretty RepoThis = Disp.text "this"
 167   pretty (RepoKindUnknown other) = Disp.text other
 168
 169 instance Parsec RepoKind where
 170   parsec = classifyRepoKind <$> P.munch1 isIdent
 171
 172 classifyRepoKind :: String -> RepoKind
 173 classifyRepoKind name = case lowercase name of
 174   "head" -> RepoHead
 175   "this" -> RepoThis
 176   _ -> RepoKindUnknown name
 177
 178 instance Parsec RepoType where
 179   parsec = classifyRepoType <$> P.munch1 isIdent
 180
 181 instance Pretty RepoType where
 182   pretty (OtherRepoType other) = Disp.text other
 183   pretty (KnownRepoType t) = pretty t
 184
 185 classifyRepoType :: String -> RepoType
 186 classifyRepoType s =
 187   maybe
 188     (OtherRepoType s)
 189     KnownRepoType
 190     (M.lookup (lowercase s) knownRepoTypeMap)
 191
 192 knownRepoTypeMap :: Map String KnownRepoType
 193 knownRepoTypeMap =
 194   M.fromList
 195     [ (name, repoType')
 196     | repoType' <- knownRepoTypes
 197     , name <- prettyShow repoType' : repoTypeAliases repoType'
 198     ]
 199
 200 isIdent :: Char -> Bool
 201 isIdent c = isAlphaNum c || c == '_' || c == '-'