Use standard printing/formatting functions

src/Collage/Commands/Splice.hs

@@ -39,7 +39,7 @@ findFragments root s sources = case (T.splitOn "/" s) of
   where
 
     go q [] (ExposeFile path) =
-      return (TL.readFile (root </> sourceDir q </> path))
+      return (cOpenFile "file source" (root </> sourceDir q </> path))
     go _ [] ExposeSections{} =
       throw ("Splice identifier «" % stext %
              "» matches a file with sections") s
@@ -73,16 +73,16 @@ doReplacements root e original =
   where
     doReplace file frag = do
       new <- case findFragments root frag e of
-        Left err -> cError err
+        Left err -> cError ("Fragment error: " % text) err
         Right x  -> x
       return (TL.replace (toIdent frag) new file)
 
 readSection :: FilePath -> T.Text -> IO TL.Text
 readSection path f = do
-  contents <- TL.readFile path
+  contents <- cOpenFile "section source" path
   case TL.breakOn (toIdent f) contents of
-    (_, "") -> cError (format ("Unable to find section " % shown %
-                               " in file " % string) f path)
+    (_, "") -> cError ("Unable to find section " % shown %
+                       " in file " % string) f path
     (_, rs) ->
       let (_, skipLine) = TL.breakOn "\n" rs
           (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)
@@ -92,6 +92,6 @@ readSection path f = do
 runSplice :: Config -> Options -> IO ()
 runSplice conf opts = do
   let root = Sys.takeDirectory (optFile opts)
-  f <- TL.readFile (root </> confDocument conf)
+  f <- cOpenFile "document" (root </> confDocument conf)
   rs <- doReplacements root (confSources conf) f
   TL.putStrLn rs

src/Collage/Commands/Test.hs

@@ -14,16 +14,16 @@ import Collage.Utils
 runTest :: Config -> Options -> IO ()
 runTest conf opts = do
   let root = Sys.takeDirectory (optFile opts)
-  cDebug (format ("running tests for " % shown) (confDocument conf))
+  cDebug ("running tests for " % shown) (confDocument conf)
   forM_ (confSources conf) $ \ samp -> do
-    cDebug (format ("- running test for " % stext) (sourceName samp))
+    cDebug ("- running test for " % stext) (sourceName samp)
     runCommand root samp
 
 runCommand :: FilePath -> Source -> IO ()
 runCommand root src = do
   forM_ (sourceCommands src) $ \ln -> do
     let dir = root </> sourceDir src
-    cDebug (format ("  - $ " % shown % " in " % string) ln dir)
+    cDebug ("  - $ " % shown % " in " % string) ln dir
     let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
     (_, _, _, h) <- Sys.createProcess process
     Sys.waitForProcess h

src/Collage/Utils.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Collage.Utils
+( cOutput
+, cDebug
+, cWarn
+, cError
+
+, cOpenFile
+
+, throw
+
+, F.format
+, (F.%)
+, F.stext
+, F.text
+, F.string
+, F.shown
+) where
+
+import qualified Formatting as F
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TL
+import qualified Data.Text.Lazy.IO as TL
+import qualified System.Directory as Sys
+import qualified System.Exit as Sys
+import qualified System.IO as Sys
+import qualified System.Posix.IO as Posix
+import qualified System.Posix.Terminal as Posix
+
+import Prelude (FilePath, IO, Either(Left), ($))
+
+throw :: F.Format (Either TL.Text r) a -> a
+throw f =
+  F.runFormat f (\ b -> Left (TL.toLazyText b))
+
+stderr :: TL.Text -> IO ()
+stderr = TL.hPutStr Sys.stderr
+
+-- | Write output to stdout
+cOutput :: TL.Text -> IO ()
+cOutput = TL.putStrLn
+
+-- | Write a debug message to stderr.
+cDebug :: F.Format (IO ()) a -> a
+cDebug msg = F.runFormat msg $ \ b ->
+  TL.hPutStrLn Sys.stderr (TL.toLazyText b)
+
+-- | Write a warning message to stderr. If we are connected to a TTY,
+-- then this will write in an orange color.
+cWarn :: F.Format (IO ()) a -> a
+cWarn msg = F.runFormat msg $ \b -> do
+  isTTY <- Posix.queryTerminal Posix.stdOutput
+  if isTTY
+    then do stderr "\x1b[93m"
+            stderr (TL.toLazyText b)
+            stderr "\x1b[39m\n"
+    else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
+
+-- | Write an error message to stderr and exit. If we are connected to
+-- a TTY, this message will be in red.
+cError :: F.Format (IO r) a -> a
+cError msg = F.runFormat msg $ \b -> do
+  isTTY <- Posix.queryTerminal Posix.stdOutput
+  if isTTY
+    then do stderr "\x1b[91m"
+            stderr (TL.toLazyText b)
+            stderr "\x1b[39m\n"
+    else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
+  Sys.exitFailure
+
+
+cOpenFile :: TL.Text -> FilePath -> IO TL.Text
+cOpenFile purpose path = do
+  exists <- Sys.doesFileExist path
+  if exists
+    then TL.readFile path
+    else cError ("Unable to open " F.% F.text F.%
+                 " file at " F.% F.string) purpose path