module Distribution.Types.SourceRepo (
SourceRepo(..),
RepoKind(..),
RepoType(..),
KnownRepoType (..),
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
import qualified Data.Map.Strict as M
data SourceRepo = SourceRepo {
repoKind :: RepoKind,
repoType :: Maybe RepoType,
repoLocation :: Maybe String,
repoModule :: Maybe String,
repoBranch :: Maybe String,
repoTag :: Maybe String,
repoSubdir :: Maybe FilePath
}
deriving (Eq, Ord, Generic, Read, Show, Typeable, Data)
emptySourceRepo :: RepoKind -> SourceRepo
emptySourceRepo kind = SourceRepo
{ repoKind = kind
, repoType = Nothing
, repoLocation = Nothing
, repoModule = Nothing
, repoBranch = Nothing
, repoTag = Nothing
, repoSubdir = Nothing
}
instance Binary SourceRepo
instance Structured SourceRepo
instance NFData SourceRepo where rnf = genericRnf
data RepoKind =
RepoHead
| RepoThis
| RepoKindUnknown String
deriving (Eq, Generic, Ord, Read, Show, Typeable, Data)
instance Binary RepoKind
instance Structured RepoKind
instance NFData RepoKind where rnf = genericRnf
data KnownRepoType = Darcs | Git | SVN | CVS
| Mercurial | GnuArch | Bazaar | Monotone
| Pijul
deriving (Eq, Generic, Ord, Read, Show, Typeable, Data, Enum, Bounded)
instance Binary KnownRepoType
instance Structured KnownRepoType
instance NFData KnownRepoType where rnf = genericRnf
instance Parsec KnownRepoType where
parsec = do
str <- P.munch1 isIdent
maybe
(P.unexpected $ "Could not parse KnownRepoType from " ++ str)
return
(M.lookup str knownRepoTypeMap)
instance Pretty KnownRepoType where
pretty = Disp.text . lowercase . show
data RepoType = KnownRepoType KnownRepoType
| OtherRepoType String
deriving (Eq, Generic, Ord, Read, Show, Typeable, Data)
instance Binary RepoType
instance Structured RepoType
instance NFData RepoType where rnf = genericRnf
knownRepoTypes :: [KnownRepoType]
knownRepoTypes = [minBound .. maxBound]
repoTypeAliases :: KnownRepoType -> [String]
repoTypeAliases Bazaar = ["bzr"]
repoTypeAliases Mercurial = ["hg"]
repoTypeAliases GnuArch = ["arch"]
repoTypeAliases _ = []
instance Pretty RepoKind where
pretty RepoHead = Disp.text "head"
pretty RepoThis = Disp.text "this"
pretty (RepoKindUnknown other) = Disp.text other
instance Parsec RepoKind where
parsec = classifyRepoKind <$> P.munch1 isIdent
classifyRepoKind :: String -> RepoKind
classifyRepoKind name = case lowercase name of
"head" -> RepoHead
"this" -> RepoThis
_ -> RepoKindUnknown name
instance Parsec RepoType where
parsec = classifyRepoType <$> P.munch1 isIdent
instance Pretty RepoType where
pretty (OtherRepoType other) = Disp.text other
pretty (KnownRepoType t) = pretty t
classifyRepoType :: String -> RepoType
classifyRepoType s =
maybe
(OtherRepoType s)
KnownRepoType
(M.lookup (lowercase s) knownRepoTypeMap)
knownRepoTypeMap :: Map String KnownRepoType
knownRepoTypeMap =
M.fromList
[ (name, repoType')
| repoType' <- knownRepoTypes
, name <- prettyShow repoType' : repoTypeAliases repoType'
]
isIdent :: Char -> Bool
isIdent c = isAlphaNum c || c == '_' || c == '-'