cabal-test-bin 0.1.3 → 0.1.4
raw patch · 6 files changed
+198/−131 lines, 6 filesdep +cabal-test-bindep +hspecdep +processdep ~base
Dependencies added: cabal-test-bin, hspec, process, regex-posix
Dependency ranges changed: base
Files
- ChangeLog.md +4/−0
- Main.hs +10/−123
- README.md +1/−1
- Test/Cabal/Path.hs +129/−0
- cabal-test-bin.cabal +32/−7
- tests/test.hs +22/−0
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.1.4++* Add library and test+ ## 0.1.3 * Add README.md, ChangeLog.md and .travis.yml
Main.hs view
@@ -1,137 +1,24 @@-{-#LANGUAGE BangPatterns#-}+{-# LANGUAGE ScopedTypeVariables #-} -import Numeric-import Data.Word-import Data.List-import Data.Char (ord,isSpace)-import Data.Bits import qualified Control.Exception as E-import Control.Applicative-import Control.Monad-import System.Posix.Files-import System.Posix.Types-import System.Directory-import System.FilePath import System.Environment import System.Exit import System.IO---- copy from https://github.com/haskell/cabal/blob/master/cabal-install/Distribution/Client/Sandbox.hs-sandboxBuildDir :: FilePath -> FilePath-sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash ""- where- sandboxDirHash = jenkins sandboxDir-- -- See http://en.wikipedia.org/wiki/Jenkins_hash_function- jenkins :: String -> Word32- jenkins str = loop_finish $ foldl' loop 0 str- where- loop :: Word32 -> Char -> Word32- loop hash key_i' = hash'''- where- key_i = toEnum . ord $ key_i'- hash' = hash + key_i- hash'' = hash' + (shiftL hash' 10)- hash''' = hash'' `xor` (shiftR hash'' 6)-- loop_finish :: Word32 -> Word32- loop_finish hash = hash'''- where- hash' = hash + (shiftL hash 3)- hash'' = hash' `xor` (shiftR hash' 11)- hash''' = hash'' + (shiftL hash'' 15)------ copy from https://hackage.haskell.org/package/cab-0.2.14/docs/src/Distribution-Cab-Sandbox.html#getSandbox--configFile :: String-configFile = "cabal.sandbox.config"--pkgDbKey :: String-pkgDbKey = "package-db:"--pkgDbKeyLen :: Int-pkgDbKeyLen = length pkgDbKey---- | Find a sandbox config file by tracing ancestor directories,--- parse it and return the package db path-getSandbox :: IO (Maybe FilePath)-getSandbox = (Just <$> getPkgDb) `E.catch` handler- where- getPkgDb = getCurrentDirectory >>= getSandboxConfigFile >>= getPackageDbDir- handler :: E.SomeException -> IO (Maybe String)- handler _ = return Nothing---- | Find a sandbox config file by tracing ancestor directories.--- Exception is thrown if not found-getSandboxConfigFile :: FilePath -> IO FilePath-getSandboxConfigFile dir = do- let cfile = dir </> configFile- exist <- doesFileExist cfile- if exist then- return cfile- else do- let dir' = takeDirectory dir- if dir == dir' then- E.throwIO $ userError "sandbox config file not found"- else- getSandboxConfigFile dir'---- | Extract a package db directory from the sandbox config file.--- Exception is thrown if the sandbox config file is broken.-getPackageDbDir :: FilePath -> IO FilePath-getPackageDbDir sconf = do- -- Be strict to ensure that an error can be caught.- !path <- extractValue . parse <$> readFile sconf- return path- where- parse = head . filter ("package-db:" `isPrefixOf`) . lines- extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen--type ProjectRootDir = FilePath-type BinaryName = FilePath---getTimeStamp :: FilePath -> IO (Either E.SomeException EpochTime)-getTimeStamp path = do- stat <- E.try $ getFileStatus path- return $ fmap modificationTime stat+import Test.Cabal.Path -searchBinary :: ProjectRootDir -> BinaryName -> IO FilePath-searchBinary rdir name = do- timeT <- getTimeStamp distTBin- msdir <- getSandbox- case msdir of- Just sdir -> do- let distS = sandboxBuildDir $ takeDirectory sdir- let distSBin = rdir </> distS </> "build" </> name </> name- timeS <- getTimeStamp distSBin- case (timeS,timeT) of- (Right s,Right t) -> return $ if t <= s then distSBin else distTBin- (Right _,Left _) -> return distSBin- (Left _,Right _) -> return distTBin- _ -> errorHandler [distSBin,distTBin]- Nothing -> do- case timeT of- (Right _) -> return distTBin- _ -> errorHandler [distTBin]- where- distTBin = rdir </> "dist" </> "build" </> name </> name- errorHandler paths = do- forM_ paths $ \path -> do- hPutStrLn stderr $ "Check:" ++ path- hPutStrLn stderr $ "Can not find exe-file:" ++ name- exitWith $ ExitFailure 2- main :: IO () main = do args <- getArgs case args of (dir:binName:[]) -> do- binPath <- searchBinary dir binName- putStrLn binPath- exitWith $ ExitSuccess+ eBinPath <- E.try $ getExePath dir binName+ case eBinPath of+ Right binPath -> do+ putStrLn binPath+ exitWith $ ExitSuccess+ Left (err::E.SomeException) -> do+ putStr $ show err+ exitWith $ ExitFailure 1 _ -> do hPutStrLn stderr "Usage: cabal-test-bin \"project's root directory\" \"executable-program-name\"" exitWith $ ExitFailure 1
README.md view
@@ -1,4 +1,4 @@-# cabal-test-bin: A program finding temploray build-binary for cabal-test+# cabal-test-bin: A program finding temporal build-binary for cabal-test [](https://hackage.haskell.org/package/cabal-test-bin) [](https://travis-ci.org/junjihashimoto/cabal-test-bin)
+ Test/Cabal/Path.hs view
@@ -0,0 +1,129 @@+{-#LANGUAGE BangPatterns#-}++module Test.Cabal.Path (+ getExePath+, getExeDir+, ProjectRootDir+, BinaryName +) where++import Numeric+import Data.Word+import Data.List+import Data.Char (ord,isSpace)+import Data.Bits+import qualified Control.Exception as E+import Control.Applicative+import System.Posix.Files+import System.Posix.Types+import System.Directory+import System.FilePath++-- copy from https://github.com/haskell/cabal/blob/master/cabal-install/Distribution/Client/Sandbox.hs+sandboxBuildDir :: FilePath -> FilePath+sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash ""+ where+ sandboxDirHash = jenkins sandboxDir++ -- See http://en.wikipedia.org/wiki/Jenkins_hash_function+ jenkins :: String -> Word32+ jenkins str = loop_finish $ foldl' loop 0 str+ where+ loop :: Word32 -> Char -> Word32+ loop hash key_i' = hash'''+ where+ key_i = toEnum . ord $ key_i'+ hash' = hash + key_i+ hash'' = hash' + (shiftL hash' 10)+ hash''' = hash'' `xor` (shiftR hash'' 6)++ loop_finish :: Word32 -> Word32+ loop_finish hash = hash'''+ where+ hash' = hash + (shiftL hash 3)+ hash'' = hash' `xor` (shiftR hash' 11)+ hash''' = hash'' + (shiftL hash'' 15)++++-- copy from https://hackage.haskell.org/package/cab-0.2.14/docs/src/Distribution-Cab-Sandbox.html#getSandbox+configFile :: String+configFile = "cabal.sandbox.config"++pkgDbKey :: String+pkgDbKey = "package-db:"++pkgDbKeyLen :: Int+pkgDbKeyLen = length pkgDbKey++-- | Find a sandbox config file by tracing ancestor directories,+-- parse it and return the package db path+getSandbox :: IO (Maybe FilePath)+getSandbox = (Just <$> getPkgDb) `E.catch` handler+ where+ getPkgDb = getCurrentDirectory >>= getSandboxConfigFile >>= getPackageDbDir+ handler :: E.SomeException -> IO (Maybe String)+ handler _ = return Nothing++-- | Find a sandbox config file by tracing ancestor directories.+-- Exception is thrown if not found+getSandboxConfigFile :: FilePath -> IO FilePath+getSandboxConfigFile dir = do+ let cfile = dir </> configFile+ exist <- doesFileExist cfile+ if exist then+ return cfile+ else do+ let dir' = takeDirectory dir+ if dir == dir' then+ E.throwIO $ userError "sandbox config file not found"+ else+ getSandboxConfigFile dir'++-- | Extract a package db directory from the sandbox config file.+-- Exception is thrown if the sandbox config file is broken.+getPackageDbDir :: FilePath -> IO FilePath+getPackageDbDir sconf = do+ -- Be strict to ensure that an error can be caught.+ !path <- extractValue . parse <$> readFile sconf+ return path+ where+ parse = head . filter ("package-db:" `isPrefixOf`) . lines+ extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen++type ProjectRootDir = FilePath+type BinaryName = FilePath++getTimeStamp :: FilePath -> IO (Either E.SomeException EpochTime)+getTimeStamp path = do+ stat <- E.try $ getFileStatus path+ return $ fmap modificationTime stat++getExePath :: ProjectRootDir -> BinaryName -> IO FilePath+getExePath rdir name = do+ timeT <- getTimeStamp distTBin+ msdir <- getSandbox+ case msdir of+ Just sdir -> do+ let distS = sandboxBuildDir $ takeDirectory sdir+ let distSBin = rdir </> distS </> "build" </> name </> name+ timeS <- getTimeStamp distSBin+ case (timeS,timeT) of+ (Right s,Right t) -> return $ if t <= s then distSBin else distTBin+ (Right _,Left _) -> return distSBin+ (Left _,Right _) -> return distTBin+ _ -> errorHandler [distSBin,distTBin]+ Nothing -> do+ case timeT of+ (Right _) -> return distTBin+ _ -> errorHandler [distTBin]+ where+ distTBin = rdir </> "dist" </> "build" </> name </> name+ errorHandler paths = E.throwIO $ userError $+ (foldr (\path msg -> msg ++ "Check:" ++ path ++ "\n") "\n" paths)+ ++ "Can not find exe-file:" ++ name ++ "\n"+ +getExeDir :: ProjectRootDir -> BinaryName -> IO FilePath+getExeDir rdir name = do+ binpath <- getExePath rdir name+ return $ takeDirectory binpath
cabal-test-bin.cabal view
@@ -1,5 +1,5 @@ name: cabal-test-bin-version: 0.1.3+version: 0.1.4 synopsis: A program for finding temporary build file during cabal-test. description: cabal-test-bin finds exe-file for cabal test below .@@ -34,13 +34,38 @@ type: git location: https://github.com/junjihashimoto/cabal-test-bin.git ++Library+ Exposed-modules: Test.Cabal.Path+ Build-Depends: base >=4 && <5+ , directory+ , filepath+ , unix+ Default-Language: Haskell2010+ ghc-options: -Wall+ executable cabal-test-bin- main-is: Main.hs+ main-is: Main.hs -- other-modules: -- other-extensions: - build-depends: base >= 4 && < 5- , directory- , filepath- , unix+ build-depends: base >=4 && <5+ , directory+ , filepath+ , unix+ , cabal-test-bin -- hs-source-dirs: - default-language: Haskell2010+ ghc-options: -Wall+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ main-is: test.hs+ hs-source-dirs: tests,dist/build/autogen+ ghc-options: -Wall++ build-depends: base+ , hspec+ , cabal-test-bin+ , regex-posix+ , process+ Default-Language: Haskell2010
+ tests/test.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE ScopedTypeVariables #-}+import Test.Hspec+import Test.Cabal.Path+import Text.Regex.Posix+import Control.Exception++shouldReturnRegex :: IO String -> String -> IO ()+shouldReturnRegex exe pattern = do+ v <- exe+ (v =~ pattern) `shouldBe` True++main :: IO ()+main = hspec $ do+ describe "library-test" $ do+ it "getExePath" $ do+ (getExePath "." "cabal-test-bin" `shouldReturn` "./dist/build/cabal-test-bin/cabal-test-bin")+ `catch`+ (\(_::SomeException) -> (getExePath "." "cabal-test-bin" `shouldReturnRegex` "./dist/dist-sandbox-(.*)/cabal-test-bin/cabal-test-bin"))+ it "getExeDir" $ do+ (getExePath "." "cabal-test-bin" `shouldReturn` "./dist/build/cabal-test-bin")+ `catch`+ (\(_::SomeException) -> (getExePath "." "cabal-test-bin" `shouldReturnRegex` "./dist/dist-sandbox-(.*)/cabal-test-bin"))