diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,26 +1,2 @@ -{-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat #-} - -import Data.Bool (bool) -import Data.Foldable (fold) -import Data.Functor (($>)) -import Distribution.CommandLine -import Distribution.PackageDescription -import Distribution.Simple -import Distribution.Simple.Setup - -installActions :: IO () -installActions = fold - [ writeManpages "man/atspkg.1" "atspkg.1" - , writeTheFuck - , writeBashCompletions "atspkg" - ] - -maybeInstallActions :: ConfigFlags -> IO () -maybeInstallActions cfs = bool nothing act cond - where act = installActions - nothing = mempty - cond = (mkFlagName "no-executable", True) `notElem` unFlagAssignment (configConfigurationsFlags cfs) - -main :: IO () -main = defaultMainWithHooks $ - simpleUserHooks { preConf = \_ flags -> maybeInstallActions flags $> emptyHookedBuildInfo } +import Distribution.Simple +main = defaultMain diff --git a/app/Language/ATS/Package/Dhall.hs b/app/Language/ATS/Package/Dhall.hs new file mode 100644 --- /dev/null +++ b/app/Language/ATS/Package/Dhall.hs @@ -0,0 +1,27 @@ +module Language.ATS.Package.Dhall ( checkPkgSet + , checkPkg + ) where + +import Data.Dependency +import qualified Data.Text as T +import Language.ATS.Package +import Quaalude + +-- | Check a @pkg.dhall@ file. +checkPkg :: FilePath + -> Bool + -> IO (Version -> ATSDependency) +checkPkg = checkDhall + +checkDhall :: Interpret a + => FilePath + -> Bool + -> IO a +checkDhall path d = + bool id detailed d $ + input auto (T.pack ('.' : pathSeparator : path)) + +checkPkgSet :: FilePath -- ^ Path to @.dhall@ file defining a package set. + -> Bool -- ^ Whether to print detailed error messages. + -> IO ATSPackageSet +checkPkgSet = checkDhall diff --git a/app/Language/ATS/Package/Upgrade.hs b/app/Language/ATS/Package/Upgrade.hs new file mode 100644 --- /dev/null +++ b/app/Language/ATS/Package/Upgrade.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Language.ATS.Package.Upgrade ( upgradeBin + ) where + +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Char (isDigit) +import Quaalude +import System.Info + +manufacturer :: String +manufacturer = case os of + "darwin" -> "apple" + _ -> "unknown" + +targetArch :: String +targetArch = g [arch, manufacturer, os] + where g = mconcat . intersperse "-" + +atspkgPath :: IO String +atspkgPath = do + home <- getEnv "HOME" + pure $ home ".local" "bin" "atspkg" + +upgradeBin :: String -> String -> IO () +upgradeBin user proj = do + + let inner = user proj + + putStrLn "Finding latest release..." + manager <- newManager tlsManagerSettings + initialRequest <- parseRequest ("https://github.com/" ++ inner ++ "/releases/latest") + response <- responseBody <$> httpLbs (initialRequest { method = "GET", redirectCount = 0 }) manager + + putStrLn "Downloading latest release..." + let strVersion = BSL.takeWhile (/='"') . BSL.dropWhile (not . isDigit) . BSL.dropWhile (/='"') $ response + binRequest = "https://github.com/" <> inner <> "/releases/download/" <> BSL.unpack strVersion <> "/atspkg-" <> targetArch + followupRequest <- parseRequest binRequest + binBytes <- responseBody <$> httpLbs (followupRequest { method = "GET" }) manager + + atsPath <- atspkgPath + createDirectoryIfMissing True (takeDirectory atsPath) + BSL.writeFile (atsPath ++ "-new") binBytes + renameFile (atsPath ++ "-new") atsPath + makeExecutable atsPath diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -7,15 +7,19 @@ import Control.Concurrent.ParallelIO.Global import Control.Monad import Data.Bool (bool) +import Data.Foldable (fold) import Data.Maybe (fromMaybe, isNothing) -import Data.Semigroup (Semigroup (..)) import qualified Data.Text.Lazy as TL import Data.Version hiding (Version (..)) import Development.Shake.ATS import Development.Shake.FilePath +import Distribution.CommandLine import Language.ATS.Package +import Language.ATS.Package.Dhall +import Language.ATS.Package.Upgrade import Lens.Micro import Options.Applicative +import Paths_ats_pkg import System.Directory import System.IO.Temp (withSystemTempDirectory) @@ -58,6 +62,7 @@ | Check { _filePath :: String, _details :: Bool } | CheckSet { _filePath :: String, _details :: Bool } | List + | Setup userCmd :: Parser Command userCmd = hsubparser @@ -73,6 +78,7 @@ <> command "check" (info check' (progDesc "Check that a pkg.dhall file is well-typed.")) <> command "check-set" (info checkSet (progDesc "Audit a package set to ensure it is well-typed.")) <> command "list" (info (pure List) (progDesc "List available packages")) + <> command "setup" (info (pure Setup) (progDesc "Install manpages and shell completions.")) ) command' :: Parser Command @@ -221,3 +227,13 @@ run (Install tgt) = runHelper False True False ["install"] tgt 0 run (Valgrind ts) = runHelper False True False ("valgrind" : ts) Nothing 0 run (Pack dir') = packageCompiler dir' +run Setup = installActions + +installActions :: IO () +installActions = do + path <- getDataFileName "man/atspkg.1" + fold + [ writeManpages path "atspkg.1" + , writeTheFuck + , writeBashCompletions "atspkg" + ] diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,6 +1,6 @@ -cabal-version: 1.18 +cabal-version: 2.0 name: ats-pkg -version: 2.11.0.10 +version: 3.0.0.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -11,9 +11,10 @@ description: A collection of scripts to simplify building ATS projects. category: Development, ATS -build-type: Custom -extra-source-files: +build-type: Simple +data-files: man/atspkg.1 +extra-source-files: dhall/config.dhall dhall/atslib.dhall dhall/atspkg-prelude.dhall @@ -24,11 +25,6 @@ type: git location: git@github.com:vmchale/atspkg.git -custom-setup - setup-depends: base -any, - Cabal >=2.2, - cli-setup >=0.2.0.1 - flag profile description: Enable profiling @@ -51,7 +47,6 @@ exposed-modules: Language.ATS.Package Distribution.ATS - build-tools: cpphs -any hs-source-dirs: src other-modules: Paths_ats_pkg @@ -61,16 +56,14 @@ Language.ATS.Package.Compiler Language.ATS.Package.Config Language.ATS.Package.Dependency - Language.ATS.Package.Dhall Language.ATS.Package.Error Language.ATS.Package.Generic Language.ATS.Package.PackageSet Language.ATS.Package.Type - Language.ATS.Package.Upgrade Language.ATS.Package.Debian Distribution.ATS.Version - System.Process.Ext - Quaalude + autogen-modules: + Paths_ats_pkg default-language: Haskell2010 other-extensions: OverloadedStrings GADTs GeneralizedNewtypeDeriving DeriveAnyClass DeriveGeneric @@ -79,7 +72,7 @@ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: - base >=4.9 && <5, + base >=4.11 && <5, http-client -any, bytestring -any, file-embed -any, @@ -91,7 +84,6 @@ zlib -any, http-client-tls -any, text -any, - directory -any, process -any, hashable -any, containers -any, @@ -102,33 +94,59 @@ shake-ats >=1.8.0.0, shake-ext >=3.0.0.0, shake-c -any, - composition-prelude >=1.3.0.0, zip-archive -any, ansi-wl-pprint -any, - binary -any, - microlens -any, dependency >=1.2.0.0, filemanip -any, - filepath -any + quaalude -any + if flag(development) + ghc-options: -Werror + +library quaalude + exposed-modules: + Quaalude + build-tools: cpphs -any + hs-source-dirs: internal + other-modules: + System.Process.Ext + default-language: Haskell2010 + build-depends: + base -any, + http-client -any, + http-client-tls -any, + process -any, + directory -any, + filepath -any, + microlens -any, + dhall -any, + ansi-wl-pprint -any, + shake -any, + bytestring -any, + composition-prelude >=1.3.0.0, + binary -any, + text -any + if !os(windows) build-depends: unix -any - - if (flag(development) && impl(ghc <8.4)) - ghc-options: -Werror executable atspkg main-is: Main.hs hs-source-dirs: app other-modules: Paths_ats_pkg + Language.ATS.Package.Dhall + Language.ATS.Package.Upgrade + autogen-modules: + Paths_ats_pkg default-language: Haskell2010 + other-extensions: OverloadedStrings ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -with-rtsopts=-I0 -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: - base -any, + base >=4.11, ats-pkg -any, optparse-applicative -any, shake-ats -any, @@ -138,7 +156,11 @@ composition-prelude -any, text -any, parallel-io -any, - shake -any + quaalude -any, + dependency -any, + bytestring -any, + shake -any, + cli-setup -any if flag(eventlog) ghc-options: -eventlog -with-rtsopts=-l diff --git a/dhall/atspkg-prelude.dhall b/dhall/atspkg-prelude.dhall --- a/dhall/atspkg-prelude.dhall +++ b/dhall/atspkg-prelude.dhall @@ -260,6 +260,9 @@ [ "-D_ATS_CCOMP_PRELUDE_NONE_", "-D_ATS_CCOMP_EXCEPTION_NONE_", "-D_ATS_CCOMP_RUNTIME_NONE_" ] in +let atsProject = "target" +in + {- We collect everything in a single record for convenience -} { mkDeb = mkDeb , emptySrc = emptySrc @@ -285,4 +288,5 @@ , ignore = ignore , debian = debian , noPrelude = noPrelude +, atsProject } diff --git a/internal/Quaalude.cpphs b/internal/Quaalude.cpphs new file mode 100644 --- /dev/null +++ b/internal/Quaalude.cpphs @@ -0,0 +1,186 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Quaalude ( hex + , bool + , intersperse + , transpose + , sortBy + , void + , unless + , when + , join + , fold + , zipWithM_ + , zipWithM + , filterM + , encode + , decode + , fromMaybe + , isPrefixOf + , isSuffixOf + , on + , both + , (***) + , (&&&) + , (<=<) + , ($>) + , first + , second + , getEnv + , exitWith + , showVersion + , traverse_ + , ExitCode (ExitSuccess) + , MonadIO (..) + -- * Miscellaneous + , makeExe + -- * "System.Process.Ext" reëxports + , silentCreateProcess + -- * "Data.Text.Lazy" reëxports + , Text + , pack + , unpack + -- * "Control.Composition" reëxports + , biaxe + , (.*) + , (.**) + , thread + -- * Dhall reëxports + , Interpret + , Inject + , Generic + , Binary + , input + , auto + , detailed + -- * Shake reëxports + , Rules + , Action + , command + , command_ + , (%>) + , need + , want + , shake + , Rebuild (..) + , (~>) + , cmd + , cmd_ + , ShakeOptions (..) + , shakeOptions + , copyFile' + , Change (..) + , Verbosity (..) + , removeFilesAfter + , Lint (..) + , takeBaseName + , takeFileName + , takeDirectory + , (-<.>) + , makeExecutable + -- * "Network.HTTP.Client.TLS" reëxports + , tlsManagerSettings + -- "Network.HTTP.Client" reëxports + , newManager + , parseRequest + , httpLbs + , Response (..) + , Request (method, redirectCount) + -- * "System.FilePath" reëxports + , () + , pathSeparator + -- * ByteString reëxports + , ByteString + -- * Helpers for pretty-printing + , (<#>) + -- * "Text.PrettyPrint.ANSI.Leijen" reëxports + , (<+>) + , text + , punctuate + , dullred + , linebreak + , dullyellow + , hardline + , hang + , indent + , putDoc + , Pretty (pretty) + , module X + -- Lens exports + , Lens' + , over + , _Just + , view + , _1 + , _2 + , _4 + , each + , (&) + , (%~) + ) where + +import Control.Arrow hiding ((<+>)) +import Control.Composition +import Control.Monad +import Control.Monad.IO.Class +import Data.Binary +import Data.Bool (bool) +import Data.ByteString.Lazy (ByteString) +import Data.Foldable (fold, traverse_) +import Data.Functor (($>)) +import Data.List +import Data.Maybe (fromMaybe) +import Data.Text.Lazy (Text, pack, unpack) +import Data.Version (showVersion) +import Development.Shake hiding (getEnv) +import Development.Shake.FilePath +import Dhall hiding (bool, Text) +import Lens.Micro hiding (both) +import Lens.Micro.Extras +import Network.HTTP.Client +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Numeric (showHex) +import System.Directory as X +import System.Environment (getEnv) +import System.Exit (ExitCode (ExitSuccess), exitWith) +import System.Info (os) +#ifndef mingw32_HOST_OS +import System.Posix.Files +#endif +import System.Process as X +import System.Process.Ext +import Text.PrettyPrint.ANSI.Leijen hiding (bool, (<$>), (<>), ()) + +infixr 5 <#> + +#ifdef mingw32_HOST_OS +makeExecutable :: FilePath -> IO () +makeExecutable = pure mempty +#else +makeExecutable :: FilePath -> IO () +makeExecutable = flip setFileMode ownerModes +#endif + +makeExe :: String +makeExe = case os of + "freebsd" -> "gmake" + "openbsd" -> "gmake" + "netbsd" -> "gmake" + "solaris" -> "gmake" + "dragonfly" -> "gmake" + _ -> "make" + +hex :: Int -> String +hex = flip showHex mempty + +instance Semigroup a => Semigroup (Action a) where + (<>) a b = (<>) <$> a <*> b + +instance (Semigroup a, Monoid a) => Monoid (Action a) where + mempty = pure mempty + mappend = (<>) + +-- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the +-- prelude. +(<#>) :: Doc -> Doc -> Doc +(<#>) a b = a <> line <> b diff --git a/internal/System/Process/Ext.hs b/internal/System/Process/Ext.hs new file mode 100644 --- /dev/null +++ b/internal/System/Process/Ext.hs @@ -0,0 +1,21 @@ +module System.Process.Ext ( silentCreateProcess + ) where + +import Control.Monad +import Development.Shake +import System.Exit +import System.Process + +verbosityErr :: Verbosity -> StdStream +verbosityErr v | v >= Loud = Inherit +verbosityErr _ = CreatePipe + +handleExit :: ExitCode -> IO () +handleExit ExitSuccess = mempty +handleExit x = exitWith x + +silentCreateProcess :: Verbosity -> CreateProcess -> IO () +silentCreateProcess v proc' | v >= Chatty = do + (_, _, _, r) <- createProcess (proc' { std_err = verbosityErr v, std_out = Inherit }) + handleExit =<< waitForProcess r +silentCreateProcess v proc' = void $ readCreateProcess (proc' { std_err = verbosityErr v }) "" diff --git a/man/atspkg.1 b/man/atspkg.1 --- a/man/atspkg.1 +++ b/man/atspkg.1 @@ -50,6 +50,8 @@ .PP \f[B]pack\f[] \- Create a tarball suitable for packaging the compiler. Takes as an argument a directory containing the unpacked compiler. +.PP +\f[B]setup\f[] \- Set up manpages and shell completions. .SH OPTIONS .TP .B \f[B]\-h\f[] \f[B]\-\-help\f[] diff --git a/src/Language/ATS/Package.hs b/src/Language/ATS/Package.hs --- a/src/Language/ATS/Package.hs +++ b/src/Language/ATS/Package.hs @@ -3,12 +3,8 @@ , mkPkg , cleanAll , buildHelper - -- * Dhall verification helpers - , checkPkgSet - , checkPkg -- * Ecosystem functionality , displayList - , upgradeBin , atspkgVersion -- * Functions involving the compiler , packageCompiler @@ -42,9 +38,7 @@ import Language.ATS.Package.Build import Language.ATS.Package.Compiler import Language.ATS.Package.Dependency -import Language.ATS.Package.Dhall import Language.ATS.Package.Error import Language.ATS.Package.Generic import Language.ATS.Package.PackageSet import Language.ATS.Package.Type -import Language.ATS.Package.Upgrade diff --git a/src/Language/ATS/Package/Compiler.hs b/src/Language/ATS/Package/Compiler.hs --- a/src/Language/ATS/Package/Compiler.hs +++ b/src/Language/ATS/Package/Compiler.hs @@ -14,7 +14,6 @@ import qualified Codec.Archive.Tar as Tar import Codec.Compression.GZip (compress, decompress) -import Control.Composition import Control.Monad import qualified Data.ByteString.Lazy as BS import Data.Dependency @@ -24,7 +23,6 @@ import Quaalude import System.Environment (getEnv) import System.FilePath.Find (find) -import System.Process.Ext (silentCreateProcess) libatsCfg :: String libatsCfg = $(embedStringFile ("dhall" "atslib.dhall")) diff --git a/src/Language/ATS/Package/Dhall.hs b/src/Language/ATS/Package/Dhall.hs deleted file mode 100644 --- a/src/Language/ATS/Package/Dhall.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Language.ATS.Package.Dhall ( checkPkgSet - , checkPkg - ) where - -import Data.Dependency -import qualified Data.Text as T -import Language.ATS.Package.PackageSet -import Language.ATS.Package.Type -import Quaalude - --- | Check a @pkg.dhall@ file. -checkPkg :: FilePath - -> Bool - -> IO (Version -> ATSDependency) -checkPkg = checkDhall - -checkDhall :: Interpret a - => FilePath - -> Bool - -> IO a -checkDhall path d = - bool id detailed d $ - input auto (T.pack ('.' : pathSeparator : path)) - -checkPkgSet :: FilePath -- ^ Path to @.dhall@ file defining a package set. - -> Bool -- ^ Whether to print detailed error messages. - -> IO ATSPackageSet -checkPkgSet = checkDhall diff --git a/src/Language/ATS/Package/Upgrade.hs b/src/Language/ATS/Package/Upgrade.hs deleted file mode 100644 --- a/src/Language/ATS/Package/Upgrade.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Language.ATS.Package.Upgrade ( upgradeBin - ) where - -import qualified Data.ByteString.Lazy.Char8 as BSL -import Data.Char (isDigit) -import Quaalude -import System.Info - -manufacturer :: String -manufacturer = case os of - "darwin" -> "apple" - _ -> "unknown" - -targetArch :: String -targetArch = g [arch, manufacturer, os] - where g = mconcat . intersperse "-" - -atspkgPath :: IO String -atspkgPath = do - home <- getEnv "HOME" - pure $ home ".local" "bin" "atspkg" - -upgradeBin :: String -> String -> IO () -upgradeBin user proj = do - - let inner = user proj - - putStrLn "Finding latest release..." - manager <- newManager tlsManagerSettings - initialRequest <- parseRequest ("https://github.com/" ++ inner ++ "/releases/latest") - response <- responseBody <$> httpLbs (initialRequest { method = "GET", redirectCount = 0 }) manager - - putStrLn "Downloading latest release..." - let strVersion = BSL.takeWhile (/='"') . BSL.dropWhile (not . isDigit) . BSL.dropWhile (/='"') $ response - binRequest = "https://github.com/" <> inner <> "/releases/download/" <> BSL.unpack strVersion <> "/atspkg-" <> targetArch - followupRequest <- parseRequest binRequest - binBytes <- responseBody <$> httpLbs (followupRequest { method = "GET" }) manager - - atsPath <- atspkgPath - createDirectoryIfMissing True (takeDirectory atsPath) - BSL.writeFile (atsPath ++ "-new") binBytes - renameFile (atsPath ++ "-new") atsPath - makeExecutable atsPath diff --git a/src/Quaalude.cpphs b/src/Quaalude.cpphs deleted file mode 100644 --- a/src/Quaalude.cpphs +++ /dev/null @@ -1,188 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Quaalude ( hex - , bool - , intersperse - , transpose - , sortBy - , void - , unless - , when - , join - , fold - , zipWithM_ - , zipWithM - , filterM - , encode - , decode - , fromMaybe - , isPrefixOf - , isSuffixOf - , on - , both - , (***) - , (&&&) - , (<=<) - , (<>) - , ($>) - , first - , second - , getEnv - , exitWith - , showVersion - , traverse_ - , ExitCode (ExitSuccess) - , MonadIO (..) - -- * Miscellaneous - , makeExe - -- * "System.Process.Ext" reëxports - , silentCreateProcess - -- * "Data.Text.Lazy" reëxports - , Text - , pack - , unpack - -- * "Control.Composition" reëxports - , biaxe - , (.*) - , (.**) - , thread - -- * Dhall reëxports - , Interpret - , Inject - , Generic - , Binary - , input - , auto - , detailed - -- * Shake reëxports - , Rules - , Action - , command - , command_ - , (%>) - , need - , want - , shake - , Rebuild (..) - , (~>) - , cmd - , cmd_ - , ShakeOptions (..) - , shakeOptions - , copyFile' - , Change (..) - , Verbosity (..) - , removeFilesAfter - , Lint (..) - , takeBaseName - , takeFileName - , takeDirectory - , (-<.>) - , makeExecutable - -- * "Network.HTTP.Client.TLS" reëxports - , tlsManagerSettings - -- "Network.HTTP.Client" reëxports - , newManager - , parseRequest - , httpLbs - , Response (..) - , Request (method, redirectCount) - -- * "System.FilePath" reëxports - , () - , pathSeparator - -- * ByteString reëxports - , ByteString - -- * Helpers for pretty-printing - , (<#>) - -- * "Text.PrettyPrint.ANSI.Leijen" reëxports - , (<+>) - , text - , punctuate - , dullred - , linebreak - , dullyellow - , hardline - , hang - , indent - , putDoc - , Pretty (pretty) - , module X - -- Lens exports - , Lens' - , over - , _Just - , view - , _1 - , _2 - , _4 - , each - , (&) - , (%~) - ) where - -import Control.Arrow hiding ((<+>)) -import Control.Composition -import Control.Monad -import Control.Monad.IO.Class -import Data.Binary -import Data.Bool (bool) -import Data.ByteString.Lazy (ByteString) -import Data.Foldable (fold, traverse_) -import Data.Functor (($>)) -import Data.List -import Data.Maybe (fromMaybe) -import Data.Semigroup -import Data.Text.Lazy (Text, pack, unpack) -import Data.Version (showVersion) -import Development.Shake hiding (getEnv) -import Development.Shake.FilePath -import Dhall hiding (bool, Text) -import Lens.Micro hiding (both) -import Lens.Micro.Extras -import Network.HTTP.Client -import Network.HTTP.Client.TLS (tlsManagerSettings) -import Numeric (showHex) -import System.Directory as X -import System.Environment (getEnv) -import System.Exit (ExitCode (ExitSuccess), exitWith) -import System.Info (os) -#ifndef mingw32_HOST_OS -import System.Posix.Files -#endif -import System.Process as X -import System.Process.Ext -import Text.PrettyPrint.ANSI.Leijen hiding (bool, (<$>), (<>), ()) - -infixr 5 <#> - -#ifdef mingw32_HOST_OS -makeExecutable :: FilePath -> IO () -makeExecutable = pure mempty -#else -makeExecutable :: FilePath -> IO () -makeExecutable = flip setFileMode ownerModes -#endif - -makeExe :: String -makeExe = case os of - "freebsd" -> "gmake" - "openbsd" -> "gmake" - "netbsd" -> "gmake" - "solaris" -> "gmake" - "dragonfly" -> "gmake" - _ -> "make" - -hex :: Int -> String -hex = flip showHex mempty - -instance Semigroup a => Semigroup (Action a) where - (<>) a b = (<>) <$> a <*> b - -instance (Semigroup a, Monoid a) => Monoid (Action a) where - mempty = pure mempty - mappend = (<>) - --- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the --- prelude. -(<#>) :: Doc -> Doc -> Doc -(<#>) a b = a <> line <> b diff --git a/src/System/Process/Ext.hs b/src/System/Process/Ext.hs deleted file mode 100644 --- a/src/System/Process/Ext.hs +++ /dev/null @@ -1,21 +0,0 @@ -module System.Process.Ext ( silentCreateProcess - ) where - -import Control.Monad -import Development.Shake -import System.Exit -import System.Process - -verbosityErr :: Verbosity -> StdStream -verbosityErr v | v >= Loud = Inherit -verbosityErr _ = CreatePipe - -handleExit :: ExitCode -> IO () -handleExit ExitSuccess = mempty -handleExit x = exitWith x - -silentCreateProcess :: Verbosity -> CreateProcess -> IO () -silentCreateProcess v proc' | v >= Chatty = do - (_, _, _, r) <- createProcess (proc' { std_err = verbosityErr v, std_out = Inherit }) - handleExit =<< waitForProcess r -silentCreateProcess v proc' = void $ readCreateProcess (proc' { std_err = verbosityErr v }) ""