Utils.hs

module Debug.Utils
  ( trace
  , logToFile
  ) where

-- base
import Control.Concurrent.MVar
  ( MVar, withMVarMasked )
import Control.Monad
  ( void )
import System.IO
  ( BufferMode(..), hSetBuffering, hFlush, hPutStrLn, stdout )
import System.IO.Unsafe
  ( unsafePerformIO )

-- code-page
import System.IO.CodePage
  ( withCP65001 )

-- deepseq
import Control.DeepSeq
  ( force )

-- directory
import qualified System.Directory as Directory
  ( createDirectoryIfMissing )

-- filepath
import qualified System.FilePath as FilePath
  ( takeDirectory )

-- time
import qualified Data.Time.Clock as Time
  ( getCurrentTime )
import qualified  Data.Time.Format as Time
  ( defaultTimeLocale, formatTime )

--------------------------------------------------------------------------------

-- | Like 'Debug.Trace.trace', but using 'withCP65001` in order to handle
-- Unicode without crashing on Windows.
trace :: String -> a -> a
trace ( force -> !str ) expr =
  unsafePerformIO $ withCP65001 do
    hSetBuffering stdout ( BlockBuffering $ Just 50 )
    hPutStrLn stdout str
    hFlush stdout
    return expr

-- | Log the second argument to the file stored in the 'MVar' in the first
-- argument.
--
-- The 'MVar' is used to avoid jumbled contents when attempting to write to
-- the file concurrently.
logToFile :: MVar FilePath -> String -> ()
logToFile logFileMVar logContents =
  unsafePerformIO $ withCP65001 $ void $ withMVarMasked logFileMVar $ \ logFile -> do
    now <- Time.getCurrentTime
    let timeString = Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d (%Hh %Mm %Ss)" now
        logContentsWithHeader = unlines
          [ replicate 80 '='
          , timeString
          , logContents
          ]
    Directory.createDirectoryIfMissing True $
      FilePath.takeDirectory logFile
    appendFile logFile logContentsWithHeader
    return logFile
{-# NOINLINE logToFile #-}