diff --git a/src/VCSWrapper/Common.hs b/src/VCSWrapper/Common.hs --- a/src/VCSWrapper/Common.hs +++ b/src/VCSWrapper/Common.hs @@ -14,9 +14,11 @@ module VCSWrapper.Common ( module VCSWrapper.Common.Types - ,module VCSWrapper.Common.Process + , module VCSWrapper.Common.VCSMonad + , module VCSWrapper.Common.Process ) where import VCSWrapper.Common.Types +import VCSWrapper.Common.VCSMonad import VCSWrapper.Common.Process diff --git a/src/VCSWrapper/Common/Process.hs b/src/VCSWrapper/Common/Process.hs --- a/src/VCSWrapper/Common/Process.hs +++ b/src/VCSWrapper/Common/Process.hs @@ -8,7 +8,7 @@ -- Stability : -- Portability : -- --- | Functions to execute external processes and run VCS. +-- | Functions to execute external processes. -- ----------------------------------------------------------------------------- @@ -16,25 +16,16 @@ vcsExec ,vcsExecThrowingOnError ,exec - ,runVcs ) where import System.Process import System.Exit import System.IO (Handle, hFlush, hClose, hGetContents, hPutStr) import Control.Concurrent -import Control.Monad.Reader +import Control.Monad.Reader (ask, liftIO, when) import qualified Control.Exception as Exc import VCSWrapper.Common.Types import Data.Maybe - -{-| - Run a VCS 'Ctx' from a 'Config' and returns the result - -} -runVcs :: Config -- ^ 'Config' for a VCS - -> Ctx t -- ^ An operation running in 'Ctx' - -> IO t -runVcs config (Ctx a) = runReaderT a config -- | Internal function to execute a VCS command. Throws an exception if the command fails. vcsExecThrowingOnError :: String -- ^ VCS shell-command, e.g. git diff --git a/src/VCSWrapper/Common/TemporaryFiles.hs b/src/VCSWrapper/Common/TemporaryFiles.hs --- a/src/VCSWrapper/Common/TemporaryFiles.hs +++ b/src/VCSWrapper/Common/TemporaryFiles.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- -- Module : VCSWrapper.Common.TemporaryFiles @@ -18,8 +19,7 @@ import System.IO import System.Directory(getTemporaryDirectory, removeFile) -import System.IO.Error(catch) -import Control.Exception(finally) +import Control.Exception as E (catch, finally, SomeException) {- | Executes given function using a tempory file. @@ -31,7 +31,7 @@ -> IO a withTempFile pattern func = do - tempdir <- catch (getTemporaryDirectory) (\_ -> return ".") + tempdir <- E.catch (getTemporaryDirectory) (\(_ :: SomeException) -> return ".") putStrLn $ "Obtained temporary directory: "++tempdir (file, handle) <- openTempFile tempdir pattern putStrLn $ "Opened file: "++file++", handle: "++show handle diff --git a/src/VCSWrapper/Common/VCSMonad.hs b/src/VCSWrapper/Common/VCSMonad.hs new file mode 100644 --- /dev/null +++ b/src/VCSWrapper/Common/VCSMonad.hs @@ -0,0 +1,29 @@ +----------------------------------------------------------------------------- +-- +-- Module : VCSWrapper.Common.VCSMonad +-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel +-- License : GPL +-- +-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com +-- Stability : +-- Portability : +-- +-- | Functions to work with the 'Ctx' monad. +-- +----------------------------------------------------------------------------- + +module VCSWrapper.Common.VCSMonad ( + runVcs +) where + +import VCSWrapper.Common.Types (Config (..), Ctx (..)) + +import Control.Monad.Reader (runReaderT) + +{-| + Run a VCS 'Ctx' from a 'Config' and returns the result + -} +runVcs :: Config -- ^ 'Config' for a VCS + -> Ctx t -- ^ An operation running in 'Ctx' + -> IO t +runVcs config (Ctx a) = runReaderT a config diff --git a/src/VCSWrapper/Git.hs b/src/VCSWrapper/Git.hs --- a/src/VCSWrapper/Git.hs +++ b/src/VCSWrapper/Git.hs @@ -46,6 +46,8 @@ import VCSWrapper.Git.Process import VCSWrapper.Git.Types +import VCSWrapper.Common.VCSMonad (runVcs) + import Data.Maybe import qualified Data.List import Data.String.Utils (strip) diff --git a/src/VCSWrapper/Mercurial.hs b/src/VCSWrapper/Mercurial.hs --- a/src/VCSWrapper/Mercurial.hs +++ b/src/VCSWrapper/Mercurial.hs @@ -32,9 +32,11 @@ import VCSWrapper.Mercurial.Types import VCSWrapper.Common.TemporaryFiles +import VCSWrapper.Common.VCSMonad (runVcs) + import System.IO import Control.Monad.Reader -import Maybe +import Data.Maybe {- | Add all new files, delete all missing files. Executes @hg addremove@. diff --git a/src/VCSWrapper/Svn.hs b/src/VCSWrapper/Svn.hs --- a/src/VCSWrapper/Svn.hs +++ b/src/VCSWrapper/Svn.hs @@ -40,13 +40,15 @@ import VCSWrapper.Svn.Process import VCSWrapper.Svn.Types +import VCSWrapper.Common.VCSMonad (runVcs) + import VCSWrapper.Common.TemporaryFiles import Control.Monad.Reader -import Maybe +import Data.Maybe import System.IO import Data.List.Utils(startswith) -import Monad (filterM) +import Control.Monad (filterM) import System.Directory(doesFileExist, getDirectoryContents) import System.FilePath(combine, splitFileName) diff --git a/vcswrapper.cabal b/vcswrapper.cabal --- a/vcswrapper.cabal +++ b/vcswrapper.cabal @@ -1,5 +1,5 @@ name: vcswrapper -version: 0.0.1 +version: 0.0.3 cabal-version: >= 1.8 build-type: Simple license: GPL @@ -16,41 +16,38 @@ author: Stephan Fortelny, Harald Jagenteufel tested-with: GHC == 7.0 data-files: LICENSE README -data-dir: "" +data-dir: . library - build-depends: MissingH >=1.1.0.3 && <1.2, - base >=4.0.0.0 && <4.5, - directory >=1.1.0.0 && <1.2, - haddock >=2.9.0 && <2.10, - haskell98 >=1.1.0.1 && <2.1, - hxt >=9.1.2 && <9.2, - mtl >=2.0.1.0 && <2.1, + build-depends: MissingH >=1.1.0.3 && <1.3, + base >=4.0.0.0 && <4.8, + directory >=1.1.0.0 && <1.3, + hxt >=9.1.2 && <9.4, + mtl >=2.0.1.0 && <2.2, parsec >=3.1.1 && <3.2, - process >=1.0.1.5 && <1.2, - filepath >=1.2.0.0 && < 1.3 + process >=1.0.1.5 && <1.3, + filepath >=1.2.0.0 && < 1.4 exposed-modules: VCSWrapper.Common VCSWrapper.Git VCSWrapper.Svn VCSWrapper.Mercurial other-modules: VCSWrapper.Svn.Types VCSWrapper.Svn.Process VCSWrapper.Svn.Parsers VCSWrapper.Git.Types VCSWrapper.Git.Parsers VCSWrapper.Common.Types VCSWrapper.Git.Process VCSWrapper.Mercurial.Process VCSWrapper.Mercurial.Types VCSWrapper.Mercurial.Parsers VCSWrapper.Common.Process VCSWrapper.Common.TemporaryFiles + VCSWrapper.Common.VCSMonad exposed: True buildable: True hs-source-dirs: src executable vcswrapper main-is: Main.hs - build-depends: MissingH >=1.1.0.3 && <1.2, - base >=4.0.0.0 && <4.5, - directory >=1.1.0.0 && <1.2, - haddock >=2.9.0 && <2.10, - haskell98 >=1.1.0.1 && <2.1, - hxt >=9.1.2 && <9.2, - mtl >=2.0.1.0 && <2.1, + build-depends: MissingH >=1.1.0.3 && <1.3, + base >=4.0.0.0 && <4.8, + directory >=1.1.0.0 && <1.3, + hxt >=9.1.2 && <9.4, + mtl >=2.0.1.0 && <2.2, parsec >=3.1.1 && <3.2, - process >=1.0.1.5 && <1.2, - filepath >=1.2.0.0 && < 1.3 + process >=1.0.1.5 && <1.3, + filepath >=1.2.0.0 && < 1.4 buildable: True hs-source-dirs: src other-modules: @@ -58,3 +55,4 @@ VCSWrapper.Git.Types VCSWrapper.Git.Parsers VCSWrapper.Common.Types VCSWrapper.Mercurial.Process VCSWrapper.Mercurial.Types VCSWrapper.Mercurial.Parsers VCSWrapper.Common.Process VCSWrapper.Common.TemporaryFiles + VCSWrapper.Common.VCSMonad