{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Types.SourceRepo (
    SourceRepo(..),
    RepoKind(..),
    RepoType(..),
    knownRepoTypes,
    emptySourceRepo,
    classifyRepoType,
    classifyRepoKind,
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Utils.Generic (lowercase)

import Distribution.Pretty
import Distribution.Parsec

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp

-- ------------------------------------------------------------
-- * Source repos
-- ------------------------------------------------------------

-- | Information about the source revision control system for a package.
--
-- When specifying a repo it is useful to know the meaning or intention of the
-- information as doing so enables automation. There are two obvious common
-- purposes: one is to find the repo for the latest development version, the
-- other is to find the repo for this specific release. The 'ReopKind'
-- specifies which one we mean (or another custom one).
--
-- A package can specify one or the other kind or both. Most will specify just
-- a head repo but some may want to specify a repo to reconstruct the sources
-- for this package release.
--
-- The required information is the 'RepoType' which tells us if it's using
-- 'Darcs', 'Git' for example. The 'repoLocation' and other details are
-- interpreted according to the repo type.
--
data SourceRepo = SourceRepo {
  -- | The kind of repo. This field is required.
  SourceRepo -> RepoKind
repoKind     :: RepoKind,

  -- | The type of the source repository system for this repo, eg 'Darcs' or
  -- 'Git'. This field is required.
  SourceRepo -> Maybe RepoType
repoType     :: Maybe RepoType,

  -- | The location of the repository. For most 'RepoType's this is a URL.
  -- This field is required.
  SourceRepo -> Maybe String
repoLocation :: Maybe String,

  -- | 'CVS' can put multiple \"modules\" on one server and requires a
  -- module name in addition to the location to identify a particular repo.
  -- Logically this is part of the location but unfortunately has to be
  -- specified separately. This field is required for the 'CVS' 'RepoType' and
  -- should not be given otherwise.
  SourceRepo -> Maybe String
repoModule   :: Maybe String,

  -- | The name or identifier of the branch, if any. Many source control
  -- systems have the notion of multiple branches in a repo that exist in the
  -- same location. For example 'Git' and 'CVS' use this while systems like
  -- 'Darcs' use different locations for different branches. This field is
  -- optional but should be used if necessary to identify the sources,
  -- especially for the 'RepoThis' repo kind.
  SourceRepo -> Maybe String
repoBranch   :: Maybe String,

  -- | The tag identify a particular state of the repository. This should be
  -- given for the 'RepoThis' repo kind and not for 'RepoHead' kind.
  --
  SourceRepo -> Maybe String
repoTag      :: Maybe String,

  -- | Some repositories contain multiple projects in different subdirectories
  -- This field specifies the subdirectory where this packages sources can be
  -- found, eg the subdirectory containing the @.cabal@ file. It is interpreted
  -- relative to the root of the repository. This field is optional. If not
  -- given the default is \".\" ie no subdirectory.
  SourceRepo -> Maybe String
repoSubdir   :: Maybe FilePath
}
  deriving (SourceRepo -> SourceRepo -> Bool
(SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool) -> Eq SourceRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceRepo -> SourceRepo -> Bool
$c/= :: SourceRepo -> SourceRepo -> Bool
== :: SourceRepo -> SourceRepo -> Bool
$c== :: SourceRepo -> SourceRepo -> Bool
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Instance of class: Eq of the constraint type Eq RepoType
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Instance of class: Eq of the constraint type Eq RepoKind
Instance of class: Eq of the constraint type Eq RepoType
Eq, Eq SourceRepo
Eq SourceRepo
-> (SourceRepo -> SourceRepo -> Ordering)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> SourceRepo)
-> (SourceRepo -> SourceRepo -> SourceRepo)
-> Ord SourceRepo
SourceRepo -> SourceRepo -> Bool
SourceRepo -> SourceRepo -> Ordering
SourceRepo -> SourceRepo -> SourceRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceRepo -> SourceRepo -> SourceRepo
$cmin :: SourceRepo -> SourceRepo -> SourceRepo
max :: SourceRepo -> SourceRepo -> SourceRepo
$cmax :: SourceRepo -> SourceRepo -> SourceRepo
>= :: SourceRepo -> SourceRepo -> Bool
$c>= :: SourceRepo -> SourceRepo -> Bool
> :: SourceRepo -> SourceRepo -> Bool
$c> :: SourceRepo -> SourceRepo -> Bool
<= :: SourceRepo -> SourceRepo -> Bool
$c<= :: SourceRepo -> SourceRepo -> Bool
< :: SourceRepo -> SourceRepo -> Bool
$c< :: SourceRepo -> SourceRepo -> Bool
compare :: SourceRepo -> SourceRepo -> Ordering
$ccompare :: SourceRepo -> SourceRepo -> Ordering
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord (Maybe a)
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Instance of class: Ord of the constraint type Ord RepoType
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord (Maybe a)
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Instance of class: Ord of the constraint type Ord RepoType
External instance of the constraint type forall a. Ord a => Ord (Maybe a)
Instance of class: Eq of the constraint type Eq SourceRepo
Instance of class: Ord of the constraint type Ord RepoKind
Instance of class: Ord of the constraint type Ord RepoType
Instance of class: Ord of the constraint type Ord SourceRepo
Instance of class: Eq of the constraint type Eq SourceRepo
Ord, (forall x. SourceRepo -> Rep SourceRepo x)
-> (forall x. Rep SourceRepo x -> SourceRepo) -> Generic SourceRepo
forall x. Rep SourceRepo x -> SourceRepo
forall x. SourceRepo -> Rep SourceRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceRepo x -> SourceRepo
$cfrom :: forall x. SourceRepo -> Rep SourceRepo x
Generic, ReadPrec [SourceRepo]
ReadPrec SourceRepo
Int -> ReadS SourceRepo
ReadS [SourceRepo]
(Int -> ReadS SourceRepo)
-> ReadS [SourceRepo]
-> ReadPrec SourceRepo
-> ReadPrec [SourceRepo]
-> Read SourceRepo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceRepo]
$creadListPrec :: ReadPrec [SourceRepo]
readPrec :: ReadPrec SourceRepo
$creadPrec :: ReadPrec SourceRepo
readList :: ReadS [SourceRepo]
$creadList :: ReadS [SourceRepo]
readsPrec :: Int -> ReadS SourceRepo
$creadsPrec :: Int -> ReadS SourceRepo
External instance of the constraint type Read Char
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
Instance of class: Read of the constraint type Read RepoType
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read RepoKind
Instance of class: Read of the constraint type Read RepoType
Instance of class: Read of the constraint type Read SourceRepo
Read, Int -> SourceRepo -> ShowS
[SourceRepo] -> ShowS
SourceRepo -> String
(Int -> SourceRepo -> ShowS)
-> (SourceRepo -> String)
-> ([SourceRepo] -> ShowS)
-> Show SourceRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceRepo] -> ShowS
$cshowList :: [SourceRepo] -> ShowS
show :: SourceRepo -> String
$cshow :: SourceRepo -> String
showsPrec :: Int -> SourceRepo -> ShowS
$cshowsPrec :: Int -> SourceRepo -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
Instance of class: Show of the constraint type Show RepoType
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show RepoKind
Instance of class: Show of the constraint type Show RepoType
Show, Typeable, Typeable SourceRepo
DataType
Constr
Typeable SourceRepo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SourceRepo -> c SourceRepo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceRepo)
-> (SourceRepo -> Constr)
-> (SourceRepo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceRepo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceRepo))
-> ((forall b. Data b => b -> b) -> SourceRepo -> SourceRepo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceRepo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceRepo -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceRepo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceRepo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo)
-> Data SourceRepo
SourceRepo -> DataType
SourceRepo -> Constr
(forall b. Data b => b -> b) -> SourceRepo -> SourceRepo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRepo -> c SourceRepo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRepo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceRepo -> u
forall u. (forall d. Data d => d -> u) -> SourceRepo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRepo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRepo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRepo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRepo -> c SourceRepo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRepo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceRepo)
$cSourceRepo :: Constr
$tSourceRepo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
gmapMp :: (forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
gmapM :: (forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRepo -> m SourceRepo
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourceRepo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceRepo -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceRepo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceRepo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRepo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRepo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRepo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRepo -> r
gmapT :: (forall b. Data b => b -> b) -> SourceRepo -> SourceRepo
$cgmapT :: (forall b. Data b => b -> b) -> SourceRepo -> SourceRepo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceRepo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceRepo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourceRepo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRepo)
dataTypeOf :: SourceRepo -> DataType
$cdataTypeOf :: SourceRepo -> DataType
toConstr :: SourceRepo -> Constr
$ctoConstr :: SourceRepo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRepo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRepo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRepo -> c SourceRepo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRepo -> c SourceRepo
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
Instance of class: Data of the constraint type Data RepoType
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data (Maybe a)
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Char
Instance of class: Data of the constraint type Data RepoType
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data (Maybe a)
External instance of the constraint type forall a. Data a => Data (Maybe a)
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Char
Instance of class: Data of the constraint type Data RepoKind
Instance of class: Data of the constraint type Data RepoType
Data)

emptySourceRepo :: RepoKind -> SourceRepo
emptySourceRepo :: RepoKind -> SourceRepo
emptySourceRepo RepoKind
kind = SourceRepo :: RepoKind
-> Maybe RepoType
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> SourceRepo
SourceRepo
    { repoKind :: RepoKind
repoKind     = RepoKind
kind
    , repoType :: Maybe RepoType
repoType     = Maybe RepoType
forall a. Maybe a
Nothing
    , repoLocation :: Maybe String
repoLocation = Maybe String
forall a. Maybe a
Nothing
    , repoModule :: Maybe String
repoModule   = Maybe String
forall a. Maybe a
Nothing
    , repoBranch :: Maybe String
repoBranch   = Maybe String
forall a. Maybe a
Nothing
    , repoTag :: Maybe String
repoTag      = Maybe String
forall a. Maybe a
Nothing
    , repoSubdir :: Maybe String
repoSubdir   = Maybe String
forall a. Maybe a
Nothing
    }

instance Binary SourceRepo
instance Structured SourceRepo
instance NFData SourceRepo where rnf :: SourceRepo -> ()
rnf = SourceRepo -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
Instance of class: NFData of the constraint type NFData RepoKind
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
Instance of class: NFData of the constraint type NFData RepoType
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
Instance of class: Generic of the constraint type Generic SourceRepo
genericRnf

-- | What this repo info is for, what it represents.
--
data RepoKind =
    -- | The repository for the \"head\" or development version of the project.
    -- This repo is where we should track the latest development activity or
    -- the usual repo people should get to contribute patches.
    RepoHead

    -- | The repository containing the sources for this exact package version
    -- or release. For this kind of repo a tag should be given to give enough
    -- information to re-create the exact sources.
  | RepoThis

  | RepoKindUnknown String
  deriving (RepoKind -> RepoKind -> Bool
(RepoKind -> RepoKind -> Bool)
-> (RepoKind -> RepoKind -> Bool) -> Eq RepoKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoKind -> RepoKind -> Bool
$c/= :: RepoKind -> RepoKind -> Bool
== :: RepoKind -> RepoKind -> Bool
$c== :: RepoKind -> RepoKind -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Eq, (forall x. RepoKind -> Rep RepoKind x)
-> (forall x. Rep RepoKind x -> RepoKind) -> Generic RepoKind
forall x. Rep RepoKind x -> RepoKind
forall x. RepoKind -> Rep RepoKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoKind x -> RepoKind
$cfrom :: forall x. RepoKind -> Rep RepoKind x
Generic, Eq RepoKind
Eq RepoKind
-> (RepoKind -> RepoKind -> Ordering)
-> (RepoKind -> RepoKind -> Bool)
-> (RepoKind -> RepoKind -> Bool)
-> (RepoKind -> RepoKind -> Bool)
-> (RepoKind -> RepoKind -> Bool)
-> (RepoKind -> RepoKind -> RepoKind)
-> (RepoKind -> RepoKind -> RepoKind)
-> Ord RepoKind
RepoKind -> RepoKind -> Bool
RepoKind -> RepoKind -> Ordering
RepoKind -> RepoKind -> RepoKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RepoKind -> RepoKind -> RepoKind
$cmin :: RepoKind -> RepoKind -> RepoKind
max :: RepoKind -> RepoKind -> RepoKind
$cmax :: RepoKind -> RepoKind -> RepoKind
>= :: RepoKind -> RepoKind -> Bool
$c>= :: RepoKind -> RepoKind -> Bool
> :: RepoKind -> RepoKind -> Bool
$c> :: RepoKind -> RepoKind -> Bool
<= :: RepoKind -> RepoKind -> Bool
$c<= :: RepoKind -> RepoKind -> Bool
< :: RepoKind -> RepoKind -> Bool
$c< :: RepoKind -> RepoKind -> Bool
compare :: RepoKind -> RepoKind -> Ordering
$ccompare :: RepoKind -> RepoKind -> Ordering
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
Instance of class: Eq of the constraint type Eq RepoKind
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Ord of the constraint type Ord RepoKind
Instance of class: Eq of the constraint type Eq RepoKind
Ord, ReadPrec [RepoKind]
ReadPrec RepoKind
Int -> ReadS RepoKind
ReadS [RepoKind]
(Int -> ReadS RepoKind)
-> ReadS [RepoKind]
-> ReadPrec RepoKind
-> ReadPrec [RepoKind]
-> Read RepoKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RepoKind]
$creadListPrec :: ReadPrec [RepoKind]
readPrec :: ReadPrec RepoKind
$creadPrec :: ReadPrec RepoKind
readList :: ReadS [RepoKind]
$creadList :: ReadS [RepoKind]
readsPrec :: Int -> ReadS RepoKind
$creadsPrec :: Int -> ReadS RepoKind
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read RepoKind
Read, Int -> RepoKind -> ShowS
[RepoKind] -> ShowS
RepoKind -> String
(Int -> RepoKind -> ShowS)
-> (RepoKind -> String) -> ([RepoKind] -> ShowS) -> Show RepoKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoKind] -> ShowS
$cshowList :: [RepoKind] -> ShowS
show :: RepoKind -> String
$cshow :: RepoKind -> String
showsPrec :: Int -> RepoKind -> ShowS
$cshowsPrec :: Int -> RepoKind -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Show, Typeable, Typeable RepoKind
DataType
Constr
Typeable RepoKind
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RepoKind -> c RepoKind)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RepoKind)
-> (RepoKind -> Constr)
-> (RepoKind -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RepoKind))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoKind))
-> ((forall b. Data b => b -> b) -> RepoKind -> RepoKind)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RepoKind -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RepoKind -> r)
-> (forall u. (forall d. Data d => d -> u) -> RepoKind -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RepoKind -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RepoKind -> m RepoKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RepoKind -> m RepoKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RepoKind -> m RepoKind)
-> Data RepoKind
RepoKind -> DataType
RepoKind -> Constr
(forall b. Data b => b -> b) -> RepoKind -> RepoKind
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoKind -> c RepoKind
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoKind
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RepoKind -> u
forall u. (forall d. Data d => d -> u) -> RepoKind -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoKind -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoKind -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoKind
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoKind -> c RepoKind
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoKind)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoKind)
$cRepoKindUnknown :: Constr
$cRepoThis :: Constr
$cRepoHead :: Constr
$tRepoKind :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
gmapMp :: (forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
gmapM :: (forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoKind -> m RepoKind
gmapQi :: Int -> (forall d. Data d => d -> u) -> RepoKind -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RepoKind -> u
gmapQ :: (forall d. Data d => d -> u) -> RepoKind -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RepoKind -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoKind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoKind -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoKind -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoKind -> r
gmapT :: (forall b. Data b => b -> b) -> RepoKind -> RepoKind
$cgmapT :: (forall b. Data b => b -> b) -> RepoKind -> RepoKind
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoKind)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoKind)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RepoKind)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoKind)
dataTypeOf :: RepoKind -> DataType
$cdataTypeOf :: RepoKind -> DataType
toConstr :: RepoKind -> Constr
$ctoConstr :: RepoKind -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoKind
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoKind
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoKind -> c RepoKind
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoKind -> c RepoKind
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
Data)

instance Binary RepoKind
instance Structured RepoKind
instance NFData RepoKind where rnf :: RepoKind -> ()
rnf = RepoKind -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
Instance of class: Generic of the constraint type Generic RepoKind
genericRnf

-- | An enumeration of common source control systems. The fields used in the
-- 'SourceRepo' depend on the type of repo. The tools and methods used to
-- obtain and track the repo depend on the repo type.
--
data RepoType = Darcs | Git | SVN | CVS
              | Mercurial | GnuArch | Bazaar | Monotone
              | OtherRepoType String
  deriving (RepoType -> RepoType -> Bool
(RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool) -> Eq RepoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoType -> RepoType -> Bool
$c/= :: RepoType -> RepoType -> Bool
== :: RepoType -> RepoType -> Bool
$c== :: RepoType -> RepoType -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Eq, (forall x. RepoType -> Rep RepoType x)
-> (forall x. Rep RepoType x -> RepoType) -> Generic RepoType
forall x. Rep RepoType x -> RepoType
forall x. RepoType -> Rep RepoType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoType x -> RepoType
$cfrom :: forall x. RepoType -> Rep RepoType x
Generic, Eq RepoType
Eq RepoType
-> (RepoType -> RepoType -> Ordering)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> RepoType)
-> (RepoType -> RepoType -> RepoType)
-> Ord RepoType
RepoType -> RepoType -> Bool
RepoType -> RepoType -> Ordering
RepoType -> RepoType -> RepoType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RepoType -> RepoType -> RepoType
$cmin :: RepoType -> RepoType -> RepoType
max :: RepoType -> RepoType -> RepoType
$cmax :: RepoType -> RepoType -> RepoType
>= :: RepoType -> RepoType -> Bool
$c>= :: RepoType -> RepoType -> Bool
> :: RepoType -> RepoType -> Bool
$c> :: RepoType -> RepoType -> Bool
<= :: RepoType -> RepoType -> Bool
$c<= :: RepoType -> RepoType -> Bool
< :: RepoType -> RepoType -> Bool
$c< :: RepoType -> RepoType -> Bool
compare :: RepoType -> RepoType -> Ordering
$ccompare :: RepoType -> RepoType -> Ordering
External instance of the constraint type Ord Char
Instance of class: Eq of the constraint type Eq RepoType
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Eq of the constraint type Eq RepoType
Ord, ReadPrec [RepoType]
ReadPrec RepoType
Int -> ReadS RepoType
ReadS [RepoType]
(Int -> ReadS RepoType)
-> ReadS [RepoType]
-> ReadPrec RepoType
-> ReadPrec [RepoType]
-> Read RepoType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RepoType]
$creadListPrec :: ReadPrec [RepoType]
readPrec :: ReadPrec RepoType
$creadPrec :: ReadPrec RepoType
readList :: ReadS [RepoType]
$creadList :: ReadS [RepoType]
readsPrec :: Int -> ReadS RepoType
$creadsPrec :: Int -> ReadS RepoType
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read RepoType
Read, Int -> RepoType -> ShowS
[RepoType] -> ShowS
RepoType -> String
(Int -> RepoType -> ShowS)
-> (RepoType -> String) -> ([RepoType] -> ShowS) -> Show RepoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoType] -> ShowS
$cshowList :: [RepoType] -> ShowS
show :: RepoType -> String
$cshow :: RepoType -> String
showsPrec :: Int -> RepoType -> ShowS
$cshowsPrec :: Int -> RepoType -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Show, Typeable, Typeable RepoType
DataType
Constr
Typeable RepoType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RepoType -> c RepoType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RepoType)
-> (RepoType -> Constr)
-> (RepoType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RepoType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoType))
-> ((forall b. Data b => b -> b) -> RepoType -> RepoType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RepoType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RepoType -> r)
-> (forall u. (forall d. Data d => d -> u) -> RepoType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RepoType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RepoType -> m RepoType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RepoType -> m RepoType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RepoType -> m RepoType)
-> Data RepoType
RepoType -> DataType
RepoType -> Constr
(forall b. Data b => b -> b) -> RepoType -> RepoType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoType -> c RepoType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RepoType -> u
forall u. (forall d. Data d => d -> u) -> RepoType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoType -> m RepoType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoType -> m RepoType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoType -> c RepoType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoType)
$cOtherRepoType :: Constr
$cMonotone :: Constr
$cBazaar :: Constr
$cGnuArch :: Constr
$cMercurial :: Constr
$cCVS :: Constr
$cSVN :: Constr
$cGit :: Constr
$cDarcs :: Constr
$tRepoType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RepoType -> m RepoType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoType -> m RepoType
gmapMp :: (forall d. Data d => d -> m d) -> RepoType -> m RepoType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoType -> m RepoType
gmapM :: (forall d. Data d => d -> m d) -> RepoType -> m RepoType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoType -> m RepoType
gmapQi :: Int -> (forall d. Data d => d -> u) -> RepoType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RepoType -> u
gmapQ :: (forall d. Data d => d -> u) -> RepoType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RepoType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoType -> r
gmapT :: (forall b. Data b => b -> b) -> RepoType -> RepoType
$cgmapT :: (forall b. Data b => b -> b) -> RepoType -> RepoType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RepoType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoType)
dataTypeOf :: RepoType -> DataType
$cdataTypeOf :: RepoType -> DataType
toConstr :: RepoType -> Constr
$ctoConstr :: RepoType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoType -> c RepoType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoType -> c RepoType
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
Data)

instance Binary RepoType
instance Structured RepoType
instance NFData RepoType where rnf :: RepoType -> ()
rnf = RepoType -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type GNFData U1
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
Instance of class: Generic of the constraint type Generic RepoType
genericRnf

knownRepoTypes :: [RepoType]
knownRepoTypes :: [RepoType]
knownRepoTypes = [RepoType
Darcs, RepoType
Git, RepoType
SVN, RepoType
CVS
                 ,RepoType
Mercurial, RepoType
GnuArch, RepoType
Bazaar, RepoType
Monotone]

repoTypeAliases :: RepoType -> [String]
repoTypeAliases :: RepoType -> [String]
repoTypeAliases RepoType
Bazaar    = [String
"bzr"]
repoTypeAliases RepoType
Mercurial = [String
"hg"]
repoTypeAliases RepoType
GnuArch   = [String
"arch"]
repoTypeAliases RepoType
_         = []

instance Pretty RepoKind where
  pretty :: RepoKind -> Doc
pretty RepoKind
RepoHead                = String -> Doc
Disp.text String
"head"
  pretty RepoKind
RepoThis                = String -> Doc
Disp.text String
"this"
  pretty (RepoKindUnknown String
other) = String -> Doc
Disp.text String
other

instance Parsec RepoKind where
  parsec :: m RepoKind
parsec = String -> RepoKind
classifyRepoKind (String -> RepoKind) -> m String -> m RepoKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.munch1 Char -> Bool
isIdent

classifyRepoKind :: String -> RepoKind
classifyRepoKind :: String -> RepoKind
classifyRepoKind String
name = case ShowS
lowercase String
name of
  String
"head" -> RepoKind
RepoHead
  String
"this" -> RepoKind
RepoThis
  String
_      -> String -> RepoKind
RepoKindUnknown String
name

instance Pretty RepoType where
  pretty :: RepoType -> Doc
pretty (OtherRepoType String
other) = String -> Doc
Disp.text String
other
  pretty RepoType
other                 = String -> Doc
Disp.text (ShowS
lowercase (RepoType -> String
forall a. Show a => a -> String
Instance of class: Show of the constraint type Show RepoType
show RepoType
other))

instance Parsec RepoType where
  parsec :: m RepoType
parsec = String -> RepoType
classifyRepoType (String -> RepoType) -> m String -> m RepoType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.munch1 Char -> Bool
isIdent

classifyRepoType :: String -> RepoType
classifyRepoType :: String -> RepoType
classifyRepoType String
s =
    RepoType -> Maybe RepoType -> RepoType
forall a. a -> Maybe a -> a
fromMaybe (String -> RepoType
OtherRepoType String
s) (Maybe RepoType -> RepoType) -> Maybe RepoType -> RepoType
forall a b. (a -> b) -> a -> b
$ String -> [(String, RepoType)] -> Maybe RepoType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
lookup (ShowS
lowercase String
s) [(String, RepoType)]
repoTypeMap
  where
    repoTypeMap :: [(String, RepoType)]
repoTypeMap = [ (String
name, RepoType
repoType')
                  | RepoType
repoType' <- [RepoType]
knownRepoTypes
                  , String
name <- RepoType -> String
forall a. Pretty a => a -> String
Instance of class: Pretty of the constraint type Pretty RepoType
prettyShow RepoType
repoType' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: RepoType -> [String]
repoTypeAliases RepoType
repoType' ]

isIdent :: Char -> Bool
isIdent :: Char -> Bool
isIdent Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'-'