Add bytestring and change log message type
This commit is contained in:
parent
9473eabf11
commit
480073894b
@ -18,6 +18,9 @@ import Data.Text qualified as T
|
|||||||
import Data.Text.IO qualified as T
|
import Data.Text.IO qualified as T
|
||||||
import Data.Text.Lazy qualified as LT
|
import Data.Text.Lazy qualified as LT
|
||||||
import Data.Text.Lazy.Builder qualified as T
|
import Data.Text.Lazy.Builder qualified as T
|
||||||
|
import Data.Text.Encoding qualified as T
|
||||||
|
import Data.Text.Lazy.Encoding qualified as LT
|
||||||
|
import Data.Text.Encoding.Error qualified as T
|
||||||
import Effectful
|
import Effectful
|
||||||
import Effectful.Concurrent.QSem
|
import Effectful.Concurrent.QSem
|
||||||
import Effectful.Dispatch.Dynamic
|
import Effectful.Dispatch.Dynamic
|
||||||
@ -27,10 +30,12 @@ import Effects.Time
|
|||||||
import UnliftIO.Exception (bracket_)
|
import UnliftIO.Exception (bracket_)
|
||||||
import UnliftIO.IO (stderr)
|
import UnliftIO.IO (stderr)
|
||||||
import Prelude hiding (log)
|
import Prelude hiding (log)
|
||||||
|
import qualified Data.ByteString as B
|
||||||
|
import qualified Data.ByteString.Lazy as LB
|
||||||
|
|
||||||
import Terminal
|
import Terminal
|
||||||
|
|
||||||
class Monoid a => LogData a where
|
class LogData a where
|
||||||
toLog :: a -> T.Builder
|
toLog :: a -> T.Builder
|
||||||
|
|
||||||
instance LogData T.Builder where
|
instance LogData T.Builder where
|
||||||
@ -39,11 +44,20 @@ instance LogData T.Builder where
|
|||||||
instance LogData Text where
|
instance LogData Text where
|
||||||
toLog = T.fromText
|
toLog = T.fromText
|
||||||
|
|
||||||
|
instance LogData LT.Text where
|
||||||
|
toLog = T.fromLazyText
|
||||||
|
|
||||||
instance LogData String where
|
instance LogData String where
|
||||||
toLog = T.fromString
|
toLog = T.fromString
|
||||||
|
|
||||||
|
instance LogData B.ByteString where
|
||||||
|
toLog = toLog . T.decodeUtf8With T.lenientDecode
|
||||||
|
|
||||||
|
instance LogData LB.ByteString where
|
||||||
|
toLog = toLog . LT.decodeUtf8With T.lenientDecode
|
||||||
|
|
||||||
data Log :: Effect where
|
data Log :: Effect where
|
||||||
Log :: Severity -> T.Builder -> Log m ()
|
Log :: (LogData a) => Severity -> a -> Log m ()
|
||||||
|
|
||||||
makeEffect ''Log
|
makeEffect ''Log
|
||||||
|
|
||||||
@ -70,11 +84,10 @@ runLogWithQsem lock logger e = do
|
|||||||
lock' <- ask
|
lock' <- ask
|
||||||
bracket_ (waitQSem lock') (signalQSem lock') $ do
|
bracket_ (waitQSem lock') (signalQSem lock') $ do
|
||||||
t <- currentTimeB
|
t <- currentTimeB
|
||||||
liftIO $ cmap (addTime t . fmtMessage) logger <& msg `WithSeverity` sev
|
liftIO $ cmap (addTime t . fmtMessage) logger <& toLog msg `WithSeverity` sev
|
||||||
)
|
)
|
||||||
e
|
e
|
||||||
|
|
||||||
|
|
||||||
stderrLogger ::
|
stderrLogger ::
|
||||||
(MonadIO m) =>
|
(MonadIO m) =>
|
||||||
LogAction m T.Builder
|
LogAction m T.Builder
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user