diff --git a/CmdDB.hs b/CmdDB.hs --- a/CmdDB.hs +++ b/CmdDB.hs @@ -188,6 +188,14 @@ , manual = Just "" } , CommandSpec { + command = Test + , commandNames = ["test"] + , document = "run tests" + , routing = RouteCabal ["test"] + , switches = [] + , manual = Nothing + } + , CommandSpec { command = Help , commandNames = ["help"] , document = "Display the help message of the command" diff --git a/GenPaths.hs b/GenPaths.hs --- a/GenPaths.hs +++ b/GenPaths.hs @@ -1,85 +1,53 @@ -{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-} +{-# LANGUAGE OverloadedStrings #-} module GenPaths (genPaths) where import Control.Applicative +import Control.Exception import Control.Monad -import Data.Attoparsec.ByteString.Char8 -import Data.Attoparsec.Enumerator -import Data.Enumerator (run, ($$)) -import Data.Enumerator.Binary (enumFile) -import Data.List +import Data.List (isSuffixOf) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.Verbosity (silent) +import Distribution.Version import System.Directory -import System.IO genPaths :: IO () genPaths = do - mnv <- getNameVersion - case mnv of - Nothing -> hPutStrLn stderr "cabal file does not exist" - Just (nm,ver) -> do - let file = "Paths_" ++ nm' ++ ".hs" - exist <- doesFileExist file - if exist then - hPutStrLn stderr $ file ++ " already exists" - else do - putStrLn $ "Writing " ++ file ++ "..." - writeFile file $ - "module Paths_" ++ nm' ++ " where\n" - ++ "import Data.Version\n" - ++ "\n" - ++ "version :: Version\n" - ++ "version = Version [" ++ ver' ++ "] []\n" - where - nm' = map (trans '-' '_') nm - ver' = map (trans '.' ',') ver - trans c1 c2 c - | c == c1 = c2 - | otherwise = c + (nm,ver) <- getCabalFile >>= getNameVersion + let file = "Paths_" ++ nm ++ ".hs" + check file >> do + putStrLn $ "Writing " ++ file ++ "..." + writeFile file $ "module Paths_" ++ nm ++ " where\n" + ++ "import Data.Version\n" + ++ "\n" + ++ "version :: Version\n" + ++ "version = " ++ show ver ++ "\n" + where + check file = do + exist <- doesFileExist file + when exist . throwIO . userError $ file ++ " already exists" -getNameVersion :: IO (Maybe (String,String)) -getNameVersion = do - mcfile <- getCabalFile - case mcfile of - Nothing -> return Nothing - Just cfile -> do - mn <- parseCabalFile cfile name - mv <- parseCabalFile cfile version - return $ do - n <- mn - v <- mv - return (n,v) +getNameVersion :: FilePath -> IO (String,Version) +getNameVersion file = do + desc <- readPackageDescription silent file + let pkg = package . packageDescription $ desc + PackageName nm = pkgName pkg + name = map (trans '-' '_') nm + version = pkgVersion pkg + return (name, version) + where + trans c1 c2 c + | c == c1 = c2 + | otherwise = c -getCabalFile :: IO (Maybe FilePath) +getCabalFile :: IO FilePath getCabalFile = do cnts <- (filter isCabal <$> getDirectoryContents ".") - >>= filterM (\file -> doesFileExist file) + >>= filterM doesFileExist case cnts of - [] -> return Nothing - cfile:_ -> return (Just cfile) + [] -> throwIO $ userError "Cabal file does not exist" + cfile:_ -> return cfile where isCabal nm = ".cabal" `isSuffixOf` nm && length nm > 6 - -parseCabalFile :: FilePath -> Parser a -> IO (Maybe a) -parseCabalFile file parser = do - res <- run (enumFile file $$ iterParser (findTarget parser)) - case res of - Right x -> return x - Left _ -> return Nothing - -findTarget :: Parser a -> Parser (Maybe a) -findTarget parser = (Just <$> parser) - <|> (anyChar >> findTarget parser) - <|> (Nothing <$ endOfInput) - -name :: Parser String -name = do - stringCI "name:" - many (char ' ') - many1 (satisfy $ notInClass " ,\t\n") - -version :: Parser String -version = do - stringCI "version:" - many (char ' ') - many1 (satisfy $ inClass "0-9.") diff --git a/Process.hs b/Process.hs deleted file mode 100644 --- a/Process.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Process ( - Iteratee, infoFromProcess - ) where - -import Data.Enumerator (Iteratee, run_, ($$)) -import Data.Enumerator.Binary (enumHandle) -import System.Process -import System.IO -import Data.ByteString (ByteString) - -infoFromProcess :: String -> Iteratee ByteString IO a -> IO a -infoFromProcess shellCommand parser = do - (Nothing, Just hdl, Nothing, _) <- createProcess proSpec - hSetEncoding hdl latin1 - run_ (enumHandle 4096 hdl $$ parser) - where - proSpec = CreateProcess { - cmdspec = ShellCommand shellCommand - , cwd = Nothing - , env = Nothing - , std_in = Inherit - , std_out = CreatePipe - , std_err = Inherit - , close_fds = True -#if __GLASGOW_HASKELL__ >= 702 - , create_group = True -#endif - } diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -77,6 +77,7 @@ | Search | Env | Add + | Test | Help deriving (Eq,Show) diff --git a/VerDB.hs b/VerDB.hs --- a/VerDB.hs +++ b/VerDB.hs @@ -7,12 +7,13 @@ import Control.Applicative import Control.Arrow (second) import Data.Attoparsec.ByteString.Char8 -import Data.Attoparsec.Enumerator import Data.ByteString (ByteString) +import Data.Conduit +import Data.Conduit.Attoparsec +import Data.Conduit.Process import Data.Map (Map) import qualified Data.Map as M import Data.Maybe -import Process ---------------------------------------------------------------- @@ -31,7 +32,7 @@ script = if installedOnly then "cabal list --installed" else "cabal list" - verInfos = infoFromProcess script cabalListParser + verInfos = runResourceT $ sourceCmd script $$ cabalListParser justOnly = map (second fromJust) . filter (isJust . snd) ---------------------------------------------------------------- @@ -41,8 +42,8 @@ ---------------------------------------------------------------- -cabalListParser :: Iteratee ByteString IO [VerInfo] -cabalListParser = iterParser verinfos +cabalListParser :: Sink ByteString IO [VerInfo] +cabalListParser = sinkParser verinfos verinfos :: Parser [VerInfo] verinfos = many1 verinfo diff --git a/cab.cabal b/cab.cabal --- a/cab.cabal +++ b/cab.cabal @@ -1,5 +1,5 @@ Name: cab -Version: 0.1.9 +Version: 0.1.10 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -16,16 +16,24 @@ Category: Distribution Cabal-Version: >= 1.6 Build-Type: Simple + Executable cab Main-Is: Main.hs if impl(ghc >= 6.12) GHC-Options: -Wall -fno-warn-unused-do-bind else GHC-Options: -Wall - Build-Depends: base >= 4.0 && < 5, process, filepath, directory, - containers, Cabal, - attoparsec >= 0.10.0.0, attoparsec-enumerator, - enumerator, bytestring + Build-Depends: base >= 4.0 && < 5 + , Cabal + , attoparsec >= 0.10.0.0 + , attoparsec-conduit + , bytestring + , conduit + , containers + , directory + , filepath + , process + , process-conduit >= 0.0.0.3 if os(windows) Build-Depends: else @@ -35,7 +43,6 @@ Env GenPaths PkgDB - Process Program Types Utils @@ -43,4 +50,4 @@ Paths_cab Source-Repository head Type: git - Location: git://github.com/kazu-yamamoto/cab.git + Location: git clone git://github.com/kazu-yamamoto/cab.git