zifter-stack 0.0.0.8 → 0.0.0.9
raw patch · 5 files changed
+246/−109 lines, 5 filesdep +hspecdep +stmdep +zifter-stack
Dependencies added: hspec, stm, zifter-stack
Files
- src/Zifter/Stack.hs +118/−80
- test/Spec.hs +1/−0
- test/TestImport.hs +11/−0
- test/Zifter/StackSpec.hs +55/−0
- zifter-stack.cabal +61/−29
src/Zifter/Stack.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-}+ module Zifter.Stack where import Control.Monad import Control.Monad.IO.Class import Data.Function (on) import Data.List- (groupBy, intersect, isInfixOf, isPrefixOf, sortOn)+ (groupBy, intersect, isInfixOf, isPrefixOf, isSuffixOf, sortOn) import Data.Maybe (mapMaybe) import Path import Path.IO@@ -23,7 +24,6 @@ #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.UnqualComponentName #endif- import Zifter.Zift stackBuildZift :: Zift ()@@ -47,24 +47,34 @@ ExitFailure c -> fail $ unwords [cmd, "failed with exit code", show c] ExitSuccess -> pure () -stackGetPackageTargetTuples :: Zift [(String, [String])]-stackGetPackageTargetTuples = do- sps <- stackGetPackageTargetTuplesAccordingToStackIDE- cps <- stackGetPackageTargetTuplesAccordingToCabalFiles- pure $ combine $ uncombine sps `intersect` uncombine cps+data Pkg =+ Pkg String+ [Target]+ deriving (Show, Eq) -combine :: Ord a => [(a, b)] -> [(a, [b])]-combine =- mapMaybe (\tups -> (,) <$> (fst <$> headMay tups) <*> pure (map snd tups)) .- groupBy ((==) `on` fst) . sortOn fst+data Target+ = Lib String+ | Test String+ | Bench String+ deriving (Show, Eq) -uncombine :: Ord a => [(a, [b])] -> [(a, b)]-uncombine xs = do- (a, bs) <- xs- b <- bs- pure (a, b)+stackGetPackages :: Zift [Pkg]+stackGetPackages =+ combinePkgs <$> stackGetPackageTargetTuplesAccordingToStackIDE <*>+ stackGetPackageTargetTuplesAccordingToCabalFiles -stackGetPackageTargetTuplesAccordingToStackIDE :: Zift [(String, [String])]+combinePkgs :: [Pkg] -> [Pkg] -> [Pkg]+combinePkgs ps1 ps2 = unTups $ intersect (toTups ps1) (toTups ps2)+ where+ toTups :: [Pkg] -> [(String, Target)]+ toTups = concatMap (\(Pkg p ts) -> map ((,) p) ts)+ unTups :: [(String, Target)] -> [Pkg]+ unTups =+ mapMaybe+ (\tups -> Pkg <$> (fst <$> headMay tups) <*> pure (map snd tups)) .+ groupBy ((==) `on` fst) . sortOn fst++stackGetPackageTargetTuplesAccordingToStackIDE :: Zift [Pkg] stackGetPackageTargetTuplesAccordingToStackIDE = do rd <- getRootDir let getErrFrom cmd = do@@ -86,86 +96,114 @@ outp <- getErrFrom "stack ide packages" let targets = lines outt let packages = lines outp- pure $ flip map packages $ \t -> (t, filter (isPrefixOf t) targets)+ let isLib = isSuffixOf ":lib"+ let isTest = isInfixOf ":test:"+ let isBench = isInfixOf ":bench:"+ pure $+ flip map packages $ \p ->+ let relevantTargets = filter (isPrefixOf p) targets+ in Pkg p $+ map Lib (filter isLib relevantTargets) +++ map Test (filter isTest relevantTargets) +++ map Bench (filter isBench relevantTargets) -stackGetPackageTargetTuplesAccordingToCabalFiles :: Zift [(String, [String])]+stackGetPackageTargetTuplesAccordingToCabalFiles :: Zift [Pkg] stackGetPackageTargetTuplesAccordingToCabalFiles = do rd <- getRootDir (_, fs) <- liftIO $ listDirRecur rd let cabalFiles = filter (not . isInfixOf ".stack-work" . toFilePath) $ filter (not . hidden) $ filter ((== ".cabal") . fileExtension) fs- (concat <$>) $- forM cabalFiles $ \cabalFile -> do- pd <-- liftIO $ readPackage- deafening $ toFilePath cabalFile- let packageDesc = flattenPackageDescription pd- name = unPackageName $ pkgName $ package packageDesc- libname = name ++ ":lib"- lib =- case library packageDesc of- Nothing -> []- Just _ -> [libname]- testnames =- map (((name ++ ":test:") ++) . testComponentName- ) $- testSuites packageDesc- pure [(name, lib ++ testnames)]- where- readPackage =+ forM cabalFiles $ \cabalFile -> do+ pd <- liftIO $ readPackage deafening $ toFilePath cabalFile+ let packageDesc = flattenPackageDescription pd+ name = unPackageName $ pkgName $ package packageDesc+ libname = name ++ ":lib"+ lib =+ case library packageDesc of+ Nothing -> []+ Just _ -> [Lib libname]+ testnames =+ map (((name ++ ":test:") ++) . testComponentName) $+ testSuites packageDesc+ benchnames =+ map (((name ++ ":bench:") ++) . benchComponentName) $+ benchmarks packageDesc+ pure $ Pkg name $ lib ++ map Test testnames ++ map Bench benchnames #if MIN_VERSION_Cabal(2,0,0)- readGenericPackageDescription+readPackage :: Verbosity -> FilePath -> IO GenericPackageDescription+readPackage = readGenericPackageDescription #else- readPackageDescription+readPackage = readPackageDescription #endif- testComponentName =+ #if MIN_VERSION_Cabal(2,0,0)- unUnqualComponentName . testName+testComponentName :: TestSuite -> String+testComponentName = unUnqualComponentName . testName #else- testName+testComponentName = testName #endif +#if MIN_VERSION_Cabal(2,0,0)+benchComponentName :: Benchmark -> String+benchComponentName = unUnqualComponentName . benchmarkName+#else+benchComponentName = benchmarkName+#endif stackBuild :: Zift () stackBuild = do+ tups <- stackGetPackages+ stack "build" -- To get the dependencies done first+ mapM_ bePedanticAboutPackage tups++stack :: String -> Zift ()+stack args = do rd <- getRootDir- let stack :: String -> Zift ()- stack args = do- let buildCmd = unwords ["stack", args]- (_, mouth, merrh, bph) <-- liftIO $- createProcess- ((shell buildCmd)- { cwd = Just $ toFilePath rd- , std_out = CreatePipe- , std_err = CreatePipe- })- bec <- liftIO $ waitForProcess bph- case mouth of- Nothing -> pure ()- Just outh -> liftIO (hGetContents outh) >>= printZift- case merrh of- Nothing -> pure ()- Just errh -> liftIO (hGetContents errh) >>= printZift- case bec of- ExitFailure c ->- fail $ unwords [buildCmd, "failed with exit code", show c]- ExitSuccess ->- printPreprocessingDone $ unwords [buildCmd, "succeeded."]- tups <- stackGetPackageTargetTuples- stack "build"- forM_ tups $ \(package_, targets) -> do- stack $ unwords ["clean", package_]- forM_ targets $ \target -> do- stack $ unwords ["build", target, "--pedantic"]- stack $ unwords ["build", target, "--pedantic", "--haddock"]- stack $ unwords- [ "build"- , target- , "--pedantic"- , "--test"- , "--test-arguments='--fail-fast --seed=42'"- ]+ let buildCmd = unwords ["stack", args]+ (_, mouth, merrh, bph) <-+ liftIO $+ createProcess+ ((shell buildCmd)+ { cwd = Just $ toFilePath rd+ , std_out = CreatePipe+ , std_err = CreatePipe+ })+ bec <- liftIO $ waitForProcess bph+ case mouth of+ Nothing -> pure ()+ Just outh -> liftIO (hGetContents outh) >>= printZift+ case merrh of+ Nothing -> pure ()+ Just errh -> liftIO (hGetContents errh) >>= printZift+ case bec of+ ExitFailure c ->+ fail $ unwords [buildCmd, "failed with exit code", show c]+ ExitSuccess -> printPreprocessingDone $ unwords [buildCmd, "succeeded."] hidden :: Path Abs t -> Bool hidden = any ((Just '.' ==) . headMay) . FP.splitPath . toFilePath++bePedanticAboutPackage :: Pkg -> Zift ()+bePedanticAboutPackage (Pkg package_ targets) = do+ stack $ unwords ["clean", package_]+ mapM_ bePedanticAboutTarget targets++bePedanticAboutTarget :: Target -> Zift ()+bePedanticAboutTarget (Lib target) = do+ stack $ unwords ["build", target, "--pedantic"]+ stack $ unwords ["build", target, "--pedantic", "--haddock"]+bePedanticAboutTarget (Test target) = do+ stack $ unwords ["build", target, "--pedantic"]+ stack $ unwords ["build", target, "--pedantic", "--haddock"]+ stack $+ unwords+ [ "build"+ , target+ , "--pedantic"+ , "--test"+ , "--test-arguments='--fail-fast --seed=42'"+ ]+bePedanticAboutTarget (Bench target) = do+ stack $ unwords ["build", target, "--pedantic"]+ stack $ unwords ["build", target, "--pedantic", "--haddock"]+ stack $ unwords ["build", target, "--pedantic", "--bench"]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/TestImport.hs view
@@ -0,0 +1,11 @@+module TestImport+ ( module X+ ) where++import Data.Maybe as X+import Data.Monoid as X++import Test.Hspec as X++import Path as X+import Path.IO as X
+ test/Zifter/StackSpec.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts #-}++module Zifter.StackSpec+ ( spec+ ) where++import TestImport++import Control.Concurrent.STM++import Zifter+import Zifter.OptParse+import Zifter.Stack+import Zifter.Zift++spec :: Spec+spec =+ describe "stackGetPackageTargetTuples" $+ it "finds the right packages for this repository" $ do+ tups <- runZiftInRepo stackGetPackages+ tups `shouldBe`+ [ Pkg "zifter" [Lib "zifter:lib", Test "zifter:test:zifter-test"]+ , Pkg "zifter-cabal" [Lib "zifter-cabal:lib"]+ , Pkg "zifter-git" [Lib "zifter-git:lib"]+ , Pkg "zifter-google-java-format"+ [Lib "zifter-google-java-format:lib"]+ , Pkg "zifter-hindent" [Lib "zifter-hindent:lib"]+ , Pkg "zifter-hlint" [Lib "zifter-hlint:lib"]+ , Pkg "zifter-stack"+ [ Lib "zifter-stack:lib"+ , Test "zifter-stack:test:zifter-stack-test"+ ]+ ]++runZiftInRepo :: Zift a -> IO a+runZiftInRepo func = do+ rd <- resolveDir' ".."+ pchan <- newTChanIO+ td <- resolveDir rd "/tmp/zifter-tmp"+ let ctx =+ ZiftContext+ { rootdir = rd+ , tmpdir = td+ , settings =+ Settings+ {setsOutputColor = False, setsOutputMode = OutputFast}+ , printChan = pchan+ , recursionList = []+ }+ zr <- runZift ctx func+ case zr of+ ZiftSuccess a -> pure a+ ZiftFailed r -> do+ expectationFailure $ "zift failed: " ++ show r+ undefined -- won't get here anyway
zifter-stack.cabal view
@@ -1,32 +1,64 @@-name: zifter-stack-version: 0.0.0.8-cabal-version: >=1.10-build-type: Simple-license: MIT-license-file: LICENSE-copyright: Copyright: (c) 2017 Tom Sydney Kerckhove-maintainer: syd.kerckhove@gmail.com-homepage: http://cs-syd.eu-synopsis: zifter-stack-description:- zifter-stack-category: Zift-author: Tom Sydney Kerckhove+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: aea9178fd023b7723e4aac9629108895cee97bfa793860b9d38d8cb49b72d75b +name: zifter-stack+version: 0.0.0.9+synopsis: zifter-stack+description: zifter-stack+category: Zift+homepage: http://cs-syd.eu+author: Tom Sydney Kerckhove+maintainer: syd.kerckhove@gmail.com+copyright: Copyright: (c) 2017 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+ library- exposed-modules:- Zifter.Stack- build-depends:- base >=4.9 && <=5,- Cabal >=1.24 && <2.1,- process -any,- filepath >=1.4 && <1.5,- directory -any,- zifter >=0.0 && <0.1,- path -any,- path-io -any,- safe >=0.3 && <0.4- default-language: Haskell2010- hs-source-dirs: src/- ghc-options: -Wall+ hs-source-dirs:+ src/+ ghc-options: -Wall+ build-depends:+ Cabal >=1.24 && <2.1+ , base >=4.9 && <=5+ , directory+ , filepath >=1.4 && <1.5+ , path+ , path-io+ , process+ , safe >=0.3 && <0.4+ , zifter >=0.0 && <0.1+ exposed-modules:+ Zifter.Stack+ other-modules:+ Paths_zifter_stack+ default-language: Haskell2010 +test-suite zifter-stack-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test/+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ Cabal >=1.24 && <2.1+ , base >=4.9 && <=5+ , directory+ , filepath >=1.4 && <1.5+ , hspec+ , path+ , path-io+ , process+ , safe >=0.3 && <0.4+ , stm+ , zifter >=0.0 && <0.1+ , zifter-stack+ other-modules:+ TestImport+ Zifter.StackSpec+ Paths_zifter_stack+ default-language: Haskell2010