bricoleur/src/Collage/Utils.hs

{-# 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