{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : Common.Types -- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel -- License : GPL -- -- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com -- Stability : -- Portability : -- -- | Defines all types and their associated accessorfunctions. -- ----------------------------------------------------------------------------- module VCSWrapper.Common.Types ( VCSType(..) ,IsLocked ,LogEntry (..) ,Ctx(..) ,Config(..) ,Author(..) ,VCSException(..) ,Status(..) ,Modification(..) ,makeConfig ,makeConfigWithEnvironment ,filePath ,modification ,isLocked ) where import Control.Monad.Reader import Data.Typeable (Typeable) import Control.Exception (Exception) import Data.Text (Text) import Control.Applicative (Applicative) -- | Available VCS types implemented in this package. data VCSType = SVN | GIT | Mercurial deriving (Show,Read, Eq) -- | Status of a file managed by the respective VCS. data Status = SVNStatus FilePath Modification IsLocked | GITStatus FilePath Modification deriving (Show,Read) -- | Retrieve the 'FilePath' of any VCS 'Status'. filePath :: Status -> FilePath filePath (SVNStatus fp _ _) = fp filePath (GITStatus fp _) = fp -- | Retrieve the 'Modification' of any VCS 'Status'. modification :: Status -> Modification modification (SVNStatus _ m _) = m modification (GITStatus _ m) = m -- | Retrieve the 'IsLocked' of any VCS 'Status'. For Git, this returns always 'False'. isLocked :: Status -> IsLocked isLocked (SVNStatus _ _ l) = l isLocked _ = False -- | Flags to describe the state of a file. data Modification = None | -- ^ File hasn't been modified. Added | -- ^ File has been selected to be managed by the respective VCS. Conflicting | -- ^ File is in conflicting state. Manually resolving the conflict may be necessary. Deleted | -- ^ File has been deleted. Modified | -- ^ File has been modified since last commit. Replaced | -- ^ File has been replaced by a different file. Untracked | -- ^ File is currently not known by the VCS. Unknown | -- ^ State of file is unknown. Ignored | -- ^ File is ignored by VCS. Missing -- ^ File is missing. deriving (Eq,Show,Read) -- | Represents a log entry in the history managed by the VCS. data LogEntry = LogEntry { mbBranch :: Maybe Text -- ^ Maybe Branchname , commitID :: Text -- ^ Commit identifier , author :: Text -- ^ Author of this commit. , email :: Text -- ^ Email address of the author. , date :: Text -- ^ Date this log entry was created. , subject :: Text -- ^ Short commit message. , body :: Text -- ^ Long body of the commit message. } deriving (Show) -- | 'True', if this file is locked by the VCS. type IsLocked = Bool -- | Configuration of the 'Ctx' the VCS commands will be executed in. data Config = Config { configCwd :: Maybe FilePath -- ^ Path to the main directory of the repository. E.g. for Git: the directory of the repository containing the @.git@ config directory. , configPath :: Maybe FilePath -- ^ Path to the vcs executable. If 'Nothing', the PATH environment variable will be search for a matching executable. , configAuthor :: Maybe Author -- ^ Author to be used for different VCS actions. If 'Nothing', the default for the selected repository will be used. , configEnvironment :: [(Text, Text)] -- ^ List of environment variables mappings passed to the underlying VCS executable. } deriving (Show, Read) -- | Author to be passed to VCS commands where applicable. data Author = Author { authorName :: Text -- ^ Name of the author. , authorEmail :: Maybe Text -- ^ Email address of the author. } deriving (Show, Read) {- | Context for all VCS commands. E.g. to create a new Git repository use something like this: >import VCSWrapper.Git >myInitRepoFn = do > let config = makeConfig "path/to/repo" Nothing Nothing > runVcs config $ initDB False -} newtype Ctx a = Ctx (ReaderT Config IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadReader Config) -- | Creates a new 'Config' with a list of environment variables. makeConfigWithEnvironment :: Maybe FilePath -- ^ Path to the main directory of the repository. E.g. for Git: the directory of the repository containing the @.git@ config directory. -> Maybe FilePath -- ^ Path to the vcs executable. If 'Nothing', the PATH environment variable will be search for a matching executable. -> Maybe Author -- ^ Author to be used for different VCS actions. If 'Nothing', the default for the selected repository will be used. -> [(Text, Text)] -- ^ List of environment variables mappings passed to the underlying VCS executable. -> Config makeConfigWithEnvironment repoPath executablePath author environment = Config { configCwd = repoPath ,configPath = executablePath ,configAuthor = author ,configEnvironment = environment } -- | Creates a new 'Config'. makeConfig :: Maybe FilePath -- ^ Path to the main directory of the repository. E.g. for Git: the directory of the repository containing the @.git@ config directory. -> Maybe FilePath -- ^ Path to the vcs executable. If 'Nothing', the PATH environment variable will be search for a matching executable. -> Maybe Author -- ^ Author to be used for different VCS actions. If 'Nothing', the default for the selected repository will be used. -> Config makeConfig repoPath executablePath author = Config { configCwd = repoPath ,configPath = executablePath ,configAuthor = author ,configEnvironment = [] } -- | This 'Exception'-type will be thrown if a VCS command fails unexpectedly. data VCSException -- | Exit code -> stdout -> errout -> 'configCwd' of the 'Config' -> List containing the executed command and its options = VCSException Int Text Text FilePath [Text] deriving (Show, Typeable) instance Exception VCSException