gdritter repos collage / 02b7c30
Use standard printing/formatting functions Getty Ritter 7 years ago
3 changed file(s) with 88 addition(s) and 9 deletion(s). Collapse all Expand all
+6
-6
src/Collage/Commands/Splice.hs less more
3939 where
4040
4141 go q [] (ExposeFile path) =
42 return (TL.readFile (root </> sourceDir q </> path))
42 return (cOpenFile "file source" (root </> sourceDir q </> path))
4343 go _ [] ExposeSections{} =
4444 throw ("Splice identifier «" % stext %
4545 "» matches a file with sections") s
7373 where
7474 doReplace file frag = do
7575 new <- case findFragments root frag e of
76 Left err -> cError err
76 Left err -> cError ("Fragment error: " % text) err
7777 Right x -> x
7878 return (TL.replace (toIdent frag) new file)
7979
8080 readSection :: FilePath -> T.Text -> IO TL.Text
8181 readSection path f = do
82 contents <- TL.readFile path
82 contents <- cOpenFile "section source" path
8383 case TL.breakOn (toIdent f) contents of
84 (_, "") -> cError (format ("Unable to find section " % shown %
85 " in file " % string) f path)
84 (_, "") -> cError ("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)
9292 runSplice :: Config -> Options -> IO ()
9393 runSplice conf opts = do
9494 let root = Sys.takeDirectory (optFile opts)
95 f <- TL.readFile (root </> confDocument conf)
95 f <- cOpenFile "document" (root </> confDocument conf)
9696 rs <- doReplacements root (confSources conf) f
9797 TL.putStrLn rs
+3
-3
src/Collage/Commands/Test.hs less more
1414 runTest :: Config -> Options -> IO ()
1515 runTest conf opts = do
1616 let root = Sys.takeDirectory (optFile opts)
17 cDebug (format ("running tests for " % shown) (confDocument conf))
17 cDebug ("running tests for " % shown) (confDocument conf)
1818 forM_ (confSources conf) $ \ samp -> do
19 cDebug (format ("- running test for " % stext) (sourceName samp))
19 cDebug ("- running test for " % stext) (sourceName samp)
2020 runCommand root samp
2121
2222 runCommand :: FilePath -> Source -> IO ()
2323 runCommand root src = do
2424 forM_ (sourceCommands src) $ \ln -> do
2525 let dir = root </> sourceDir src
26 cDebug (format (" - $ " % shown % " in " % string) ln dir)
26 cDebug (" - $ " % shown % " in " % string) ln dir
2727 let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
2828 (_, _, _, h) <- Sys.createProcess process
2929 Sys.waitForProcess h
+79
-0
src/Collage/Utils.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Collage.Utils
4 ( cOutput
5 , cDebug
6 , cWarn
7 , cError
8
9 , cOpenFile
10
11 , throw
12
13 , F.format
14 , (F.%)
15 , F.stext
16 , F.text
17 , F.string
18 , F.shown
19 ) where
20
21 import qualified Formatting as F
22 import qualified Data.Text.Lazy as TL
23 import qualified Data.Text.Lazy.Builder as TL
24 import qualified Data.Text.Lazy.IO as TL
25 import qualified System.Directory as Sys
26 import qualified System.Exit as Sys
27 import qualified System.IO as Sys
28 import qualified System.Posix.IO as Posix
29 import qualified System.Posix.Terminal as Posix
30
31 import Prelude (FilePath, IO, Either(Left), ($))
32
33 throw :: F.Format (Either TL.Text r) a -> a
34 throw f =
35 F.runFormat f (\ b -> Left (TL.toLazyText b))
36
37 stderr :: TL.Text -> IO ()
38 stderr = TL.hPutStr Sys.stderr
39
40 -- | Write output to stdout
41 cOutput :: TL.Text -> IO ()
42 cOutput = TL.putStrLn
43
44 -- | Write a debug message to stderr.
45 cDebug :: F.Format (IO ()) a -> a
46 cDebug msg = F.runFormat msg $ \ b ->
47 TL.hPutStrLn Sys.stderr (TL.toLazyText b)
48
49 -- | Write a warning message to stderr. If we are connected to a TTY,
50 -- then this will write in an orange color.
51 cWarn :: F.Format (IO ()) a -> a
52 cWarn msg = F.runFormat msg $ \b -> do
53 isTTY <- Posix.queryTerminal Posix.stdOutput
54 if isTTY
55 then do stderr "\x1b[93m"
56 stderr (TL.toLazyText b)
57 stderr "\x1b[39m\n"
58 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
59
60 -- | Write an error message to stderr and exit. If we are connected to
61 -- a TTY, this message will be in red.
62 cError :: F.Format (IO r) a -> a
63 cError msg = F.runFormat msg $ \b -> do
64 isTTY <- Posix.queryTerminal Posix.stdOutput
65 if isTTY
66 then do stderr "\x1b[91m"
67 stderr (TL.toLazyText b)
68 stderr "\x1b[39m\n"
69 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
70 Sys.exitFailure
71
72
73 cOpenFile :: TL.Text -> FilePath -> IO TL.Text
74 cOpenFile purpose path = do
75 exists <- Sys.doesFileExist path
76 if exists
77 then TL.readFile path
78 else cError ("Unable to open " F.% F.text F.%
79 " file at " F.% F.string) purpose path