gdritter repos bricoleur / cb77bdb
Capture command output and print it prettier Getty Ritter 6 years ago
4 changed file(s) with 57 addition(s) and 11 deletion(s). Collapse all Expand all
7373 where
7474 doReplace file frag = do
7575 new <- case findFragments root frag e of
76 Left err -> cError ("Fragment error: " % text) err
76 Left err -> cDie ("Fragment error: " % text) err
7777 Right x -> x
7878 return (TL.replace (toIdent frag) new file)
7979
8181 readSection path f = do
8282 contents <- cOpenFile "section source" path
8383 case TL.breakOn (toIdent f) contents of
84 (_, "") -> cError ("Unable to find section " % shown %
85 " in file " % string) f path
84 (_, "") -> cDie ("Unable to find section " % shown %
85 " in file " % string) f path
8686 (_, rs) ->
8787 let (_, skipLine) = TL.breakOn "\n" rs
8888 (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)
33 module Bricoleur.Commands.Test (runTest) where
44
55 import Control.Monad (forM_)
6 import qualified Data.ByteString.Lazy.Char8 as B
7 import qualified GHC.IO.Exception as Exn
68 import System.FilePath ((</>))
79 import qualified System.FilePath as Sys
810 import qualified System.Process as Sys
1012 import Bricoleur.Opts
1113 import Bricoleur.Config
1214 import Bricoleur.Utils
15
1316
1417 runTest :: Config -> Options -> IO ()
1518 runTest conf opts = do
1922 cDebug ("- running test for " % stext) (sourceName samp)
2023 runCommand root samp
2124
25
2226 runCommand :: FilePath -> Source -> IO ()
2327 runCommand root src = do
2428 forM_ (sourceCommands src) $ \ln -> do
2529 let dir = root </> sourceDir src
26 cDebug (" - $ " % shown % " in " % string) ln dir
27 let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
28 (_, _, _, h) <- Sys.createProcess process
29 Sys.waitForProcess h
30 cDebug (" $ " % string % " (in " % string % ")") ln dir
31 (outH, inH) <- Sys.createPipe
32 let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src)
33 , Sys.std_out = Sys.UseHandle inH
34 , Sys.std_err = Sys.UseHandle inH
35 }
36 (_, _, _, p) <- Sys.createProcess process
37 bufOutput <- B.hGetContents outH
38 code <- Sys.waitForProcess p
39 case code of
40 Exn.ExitSuccess -> return ()
41 Exn.ExitFailure n -> do
42 let idtext = map (B.append " - ") (B.lines bufOutput)
43 cError ("\nCommand '" % string %
44 "' exited with error (" % shown %
45 ")") ln n
46 mapM_ bsErrorLn idtext
2121 } deriving (Eq, Show)
2222
2323 desc :: String
24 desc = "FINISH ME"
24 desc = "Bricoleur: a tool for testing and stiching code into documents"
2525
2626 opts :: Opt.ParserInfo Options
2727 opts = Opt.info (p Opt.<**> Opt.helper)
55 , cDebug
66 , cWarn
77 , cError
8 , cDie
9 , bsErrorLn
810
911 , cOpenFile
1012
1921 ) where
2022
2123 import qualified Formatting as F
24 import qualified Data.ByteString.Lazy.Char8 as BS
2225 import qualified Data.Text.Lazy as TL
2326 import qualified Data.Text.Lazy.Builder as TL
2427 import qualified Data.Text.Lazy.IO as TL
3033
3134 import Prelude (FilePath, IO, Either(Left), ($))
3235
36 -- | Produce a 'Left' value from a format string
3337 throw :: F.Format (Either TL.Text r) a -> a
3438 throw f =
3539 F.runFormat f (\ b -> Left (TL.toLazyText b))
3640
41
3742 stderr :: TL.Text -> IO ()
3843 stderr = TL.hPutStr Sys.stderr
44
3945
4046 -- | Write output to stdout
4147 cOutput :: TL.Text -> IO ()
4248 cOutput = TL.putStrLn
4349
50
4451 -- | Write a debug message to stderr.
4552 cDebug :: F.Format (IO ()) a -> a
4653 cDebug msg = F.runFormat msg $ \ b ->
4754 TL.hPutStrLn Sys.stderr (TL.toLazyText b)
55
4856
4957 -- | Write a warning message to stderr. If we are connected to a TTY,
5058 -- then this will write in an orange color.
5765 stderr "\x1b[39m\n"
5866 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
5967
68
6069 -- | Write an error message to stderr and exit. If we are connected to
6170 -- a TTY, this message will be in red.
62 cError :: F.Format (IO r) a -> a
71 cError :: F.Format (IO ()) a -> a
6372 cError msg = F.runFormat msg $ \b -> do
73 isTTY <- Posix.queryTerminal Posix.stdOutput
74 if isTTY
75 then do stderr "\x1b[91m"
76 stderr (TL.toLazyText b)
77 stderr "\x1b[39m\n"
78 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
79
80 -- | Write an error message to stderr and exit. If we are connected to
81 -- a TTY, this message will be in red.
82 cDie :: F.Format (IO r) a -> a
83 cDie msg = F.runFormat msg $ \ b -> do
6484 isTTY <- Posix.queryTerminal Posix.stdOutput
6585 if isTTY
6686 then do stderr "\x1b[91m"
7090 Sys.exitFailure
7191
7292
93 bsErrorLn :: BS.ByteString -> IO ()
94 bsErrorLn bs = do
95 isTTY <- Posix.queryTerminal Posix.stdOutput
96 if isTTY
97 then do BS.hPutStr Sys.stderr "\x1b[91m"
98 BS.hPutStr Sys.stderr bs
99 BS.hPutStr Sys.stderr "\x1b[39m\n"
100 else BS.hPutStrLn Sys.stderr bs
101
73102 cOpenFile :: TL.Text -> FilePath -> IO TL.Text
74103 cOpenFile purpose path = do
75104 exists <- Sys.doesFileExist path
76105 if exists
77106 then TL.readFile path
78 else cError ("Unable to open " F.% F.text F.%
79 " file at " F.% F.string) purpose path
107 else cDie ("Unable to open " F.% F.text F.%
108 " file at " F.% F.string) purpose path