Commit cb77bdbea681c67f3e55215b5a848cf52cb453e2 - collage

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

-3

src/Bricoleur/Commands/Splice.hs less more

73	73	where
74	74	doReplace file frag = do
75	75	new <- case findFragments root frag e of
76		Left err -> c~~Error~~ ("Fragment error: " % text) err
	76	Left err -> cDie ("Fragment error: " % text) err
77	77	Right x -> x
78	78	return (TL.replace (toIdent frag) new file)
79	79

81	81	readSection path f = do
82	82	contents <- cOpenFile "section source" path
83	83	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
86	86	(_, rs) ->
87	87	let (_, skipLine) = TL.breakOn "\n" rs
88	88	(section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)

+21

-4

src/Bricoleur/Commands/Test.hs less more

3	3	module Bricoleur.Commands.Test (runTest) where
4	4
5	5	import Control.Monad (forM_)
	6	import qualified Data.ByteString.Lazy.Char8 as B
	7	import qualified GHC.IO.Exception as Exn
6	8	import System.FilePath ((</>))
7	9	import qualified System.FilePath as Sys
8	10	import qualified System.Process as Sys

10	12	import Bricoleur.Opts
11	13	import Bricoleur.Config
12	14	import Bricoleur.Utils
	15
13	16
14	17	runTest :: Config -> Options -> IO ()
15	18	runTest conf opts = do

19	22	cDebug ("- running test for " % stext) (sourceName samp)
20	23	runCommand root samp
21	24
	25
22	26	runCommand :: FilePath -> Source -> IO ()
23	27	runCommand root src = do
24	28	forM_ (sourceCommands src) $ \ln -> do
25	29	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

-1

src/Bricoleur/Opts.hs less more

21	21	} deriving (Eq, Show)
22	22
23	23	desc :: String
24		desc = "~~FINISH ME~~"
	24	desc = "Bricoleur: a tool for testing and stiching code into documents"
25	25
26	26	opts :: Opt.ParserInfo Options
27	27	opts = Opt.info (p Opt.<**> Opt.helper)

+32

-3

src/Bricoleur/Utils.hs less more

5	5	, cDebug
6	6	, cWarn
7	7	, cError
	8	, cDie
	9	, bsErrorLn
8	10
9	11	, cOpenFile
10	12

19	21	) where
20	22
21	23	import qualified Formatting as F
	24	import qualified Data.ByteString.Lazy.Char8 as BS
22	25	import qualified Data.Text.Lazy as TL
23	26	import qualified Data.Text.Lazy.Builder as TL
24	27	import qualified Data.Text.Lazy.IO as TL

30	33
31	34	import Prelude (FilePath, IO, Either(Left), ($))
32	35
	36	-- \| Produce a 'Left' value from a format string
33	37	throw :: F.Format (Either TL.Text r) a -> a
34	38	throw f =
35	39	F.runFormat f (\ b -> Left (TL.toLazyText b))
36	40
	41
37	42	stderr :: TL.Text -> IO ()
38	43	stderr = TL.hPutStr Sys.stderr
	44
39	45
40	46	-- \| Write output to stdout
41	47	cOutput :: TL.Text -> IO ()
42	48	cOutput = TL.putStrLn
43	49
	50
44	51	-- \| Write a debug message to stderr.
45	52	cDebug :: F.Format (IO ()) a -> a
46	53	cDebug msg = F.runFormat msg $ \ b ->
47	54	TL.hPutStrLn Sys.stderr (TL.toLazyText b)
	55
48	56
49	57	-- \| Write a warning message to stderr. If we are connected to a TTY,
50	58	-- then this will write in an orange color.

57	65	stderr "\x1b[39m\n"
58	66	else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
59	67
	68
60	69	-- \| Write an error message to stderr and exit. If we are connected to
61	70	-- a TTY, this message will be in red.
62		cError :: F.Format (IO r) a -> a
	71	cError :: F.Format (IO ()) a -> a
63	72	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
64	84	isTTY <- Posix.queryTerminal Posix.stdOutput
65	85	if isTTY
66	86	then do stderr "\x1b[91m"

70	90	Sys.exitFailure
71	91
72	92
	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
73	102	cOpenFile :: TL.Text -> FilePath -> IO TL.Text
74	103	cOpenFile purpose path = do
75	104	exists <- Sys.doesFileExist path
76	105	if exists
77	106	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