1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{- Debug output
-
- Copyright 2021 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-tabs -w #-}
module Utility.Debug (
DebugSource(..),
DebugSelector(..),
configureDebug,
getDebugSelector,
debug,
fastDebug
) where
import qualified Data.ByteString as S
import Data.IORef
import Data.String
import Data.Time
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Semigroup as Sem
import Prelude
import Utility.FileSystemEncoding
-- | The source of a debug message. For example, this could be a module or
-- function name.
newtype DebugSource = DebugSource S.ByteString
deriving (Eq, Show)
instance IsString DebugSource where
fromString = DebugSource . encodeBS
-- | Selects whether to display a message from a source.
data DebugSelector
= DebugSelector (DebugSource -> Bool)
| NoDebugSelector
instance Sem.Semigroup DebugSelector where
DebugSelector a <> DebugSelector b = DebugSelector (\v -> a v || b v)
NoDebugSelector <> NoDebugSelector = NoDebugSelector
NoDebugSelector <> b = b
a <> NoDebugSelector = a
instance Monoid DebugSelector where
mempty = NoDebugSelector
-- | Configures debugging.
configureDebug
:: (S.ByteString -> IO ())
-- ^ Used to display debug output.
-> DebugSelector
-> IO ()
configureDebug src p = writeIORef debugConfigGlobal (src, p)
-- | Gets the currently configured DebugSelector.
getDebugSelector :: IO DebugSelector
getDebugSelector = snd <$> readIORef debugConfigGlobal
-- A global variable for the debug configuration.
{-# NOINLINE debugConfigGlobal #-}
debugConfigGlobal :: IORef (S.ByteString -> IO (), DebugSelector)
debugConfigGlobal = unsafePerformIO $ newIORef (dontshow, selectnone)
where
dontshow _ = return ()
selectnone = NoDebugSelector
-- | Displays a debug message, if that has been enabled by configureDebug.
--
-- This is reasonably fast when debugging is not enabled, but since it does
-- have to consult a IORef each time, using it in a tight loop may slow
-- down the program.
debug :: DebugSource -> String -> IO ()
debug src msg = readIORef debugConfigGlobal >>= \case
(displayer, NoDebugSelector) ->
displayer =<< formatDebugMessage src msg
(displayer, DebugSelector p)
| p src -> displayer =<< formatDebugMessage src msg
| otherwise -> return ()
-- | Displays a debug message, if the DebugSelector allows.
--
-- When the DebugSelector does not let the message be displayed, this runs
-- very quickly, allowing it to be used inside tight loops.
fastDebug :: DebugSelector -> DebugSource -> String -> IO ()
fastDebug NoDebugSelector src msg = do
(displayer, _) <- readIORef debugConfigGlobal
displayer =<< formatDebugMessage src msg
fastDebug (DebugSelector p) src msg
| p src = fastDebug NoDebugSelector src msg
| otherwise = return ()
formatDebugMessage :: DebugSource -> String -> IO S.ByteString
formatDebugMessage (DebugSource src) msg = do
t <- encodeBS . formatTime defaultTimeLocale "[%F %X%Q]"
<$> getZonedTime
return (t <> " (" <> src <> ") " <> encodeBS msg)
|
