Move to another representation

package.yaml

@@ -1,13 +1,14 @@
-name:                ris-utils
+---
-version:             0.0.3
+name: ris-utils
-homepage:            "https://git.fiskhamn.se/steffenomak/ris-utils#readme"
+version: 0.0.3
-license:             BSD3
+homepage: "https://git.fiskhamn.se/steffenomak/ris-utils#readme"
-author:              "Stefan Risberg"
+license: BSD3
-maintainer:          "steffenomak@gmail.com"
+author: "Stefan Risberg"
-copyright:           "2023 Stefan Risberg"
+maintainer: "steffenomak@gmail.com"
+copyright: "2023 Stefan Risberg"
 
 extra-source-files:
-- README.md
+  - README.md
 
 # Metadata used when publishing your package
 # synopsis:            Short description of your package
@@ -16,30 +17,31 @@ extra-source-files:
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README at <https://git.fiskhamn.se/steffenomak/ris-utils#readme>
+description: Please see the README at <https://git.fiskhamn.se/steffenomak/ris-utils#readme>
 
 dependencies:
-- base >= 4.7 && < 5
+  - base >= 4.7 && < 5
-- text == 2.*
+  - text == 2.*
-- effectful-core >= 2.2.2.0 && < 3
+  - effectful-core >= 2.2.2.0 && < 3
-- effectful >= 2.2.2.0 && < 3
+  - effectful >= 2.2.2.0 && < 3
-- effectful-th == 1.*
+  - effectful-th == 1.*
-- chronos >= 1.1.5 && < 2
+  - chronos >= 1.1.5 && < 2
-- torsor == 0.1
+  - torsor == 0.1
-- unliftio == 0.2.*
+  - unliftio == 0.2.*
-- co-log-core == 0.3.*
+  - co-log-core == 0.3.*
-- bytestring == 0.11.*
+  - bytestring == 0.11.*
+  - string-conv == 0.2.*
 
 ghc-options:
-- -Wall
+  - -Wall
-- -Wcompat
+  - -Wcompat
-- -Widentities
+  - -Widentities
-- -Wincomplete-record-updates
+  - -Wincomplete-record-updates
-- -Wincomplete-uni-patterns
+  - -Wincomplete-uni-patterns
-- -Wmissing-export-lists
+  - -Wmissing-export-lists
-- -Wmissing-home-modules
+  - -Wmissing-home-modules
-- -Wpartial-fields
+  - -Wpartial-fields
-- -Wredundant-constraints
+  - -Wredundant-constraints
 
 library:
   source-dirs: src

ris-utils.cabal

@@ -62,6 +62,7 @@ library
     , effectful >=2.2.2.0 && <3
     , effectful-core >=2.2.2.0 && <3
     , effectful-th ==1.*
+    , string-conv ==0.2.*
     , text ==2.*
     , torsor ==0.1
     , unliftio ==0.2.*

src/Effects/Log.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE PatternSynonyms #-}
 
 module Effects.Log (
@@ -10,17 +12,17 @@ module Effects.Log (
   Log,
   log,
   LogData (..),
+  ls,
 ) where
 
 import Colog.Core
+import Data.String (IsString (..))
+import Data.String.Conv
 import Data.Text (Text, justifyLeft)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Data.Text.Lazy qualified as LT
 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.Concurrent.QSem
 import Effectful.Dispatch.Dynamic
@@ -30,40 +32,22 @@ import Effects.Time
 import UnliftIO.Exception (bracket_)
 import UnliftIO.IO (stderr)
 import Prelude hiding (log)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as LB
 
 import Terminal
 
-class LogData a where
+newtype LogData = LogData T.Builder
-  toLog :: a -> T.Builder
+  deriving newtype (IsString)
-
+  deriving newtype (Semigroup)
-instance LogData T.Builder where
+  deriving newtype (Monoid)
-  toLog = id
-
-instance LogData Text where
-  toLog = T.fromText
-
-instance LogData LT.Text where
-  toLog = T.fromLazyText
-
-instance LogData String where
-  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
-  Log :: Severity -> T.Builder -> Log m ()
+  Log :: Severity -> LogData -> Log m ()
 
 makeEffect ''Log
 
 runLog ::
   (Time :> es, Concurrent :> es, IOE :> es) =>
-  LogAction IO T.Builder ->
+  LogAction IO LogData ->
   Eff (Log : es) a ->
   Eff es a
 runLog logger e = do
@@ -73,7 +57,7 @@ runLog logger e = do
 runLogWithQsem ::
   (Time :> es, Concurrent :> es, IOE :> es) =>
   QSem ->
-  LogAction IO T.Builder ->
+  LogAction IO LogData ->
   Eff (Log : es) a ->
   Eff es a
 runLogWithQsem lock logger e = do
@@ -83,29 +67,39 @@ runLogWithQsem lock logger e = do
         Log sev msg -> do
           lock' <- ask
           bracket_ (waitQSem lock') (signalQSem lock') $ do
-            t <- currentTimeB
+            t <- LogData <$> currentTimeB
             liftIO $ cmap (addTime t . fmtMessage) logger <& msg `WithSeverity` sev
     )
     e
 
 stderrLogger ::
   (MonadIO m) =>
-  LogAction m T.Builder
+  LogAction m LogData
-stderrLogger = LogAction (liftIO . T.hPutStrLn stderr . LT.toStrict . T.toLazyText)
+stderrLogger =
+  LogAction
+    ( \(LogData d) ->
+        liftIO . T.hPutStrLn stderr . LT.toStrict . T.toLazyText $ d
+    )
 
-fmtMessage :: WithSeverity T.Builder -> T.Builder
+fmtMessage :: WithSeverity LogData -> LogData
-fmtMessage (WithSeverity txt sev) = "[" <> T.fromText (justifyLeft 7 ' ' (colorSev sev)) <> "] - " <> txt
+fmtMessage (WithSeverity txt sev) = "[" <> ls (justifyLeft 7 ' ' (colorSev sev)) <> "] - " <> txt
  where
   colorSev :: Severity -> Text
   colorSev W = colorNormal Red . tshow $ W
   colorSev a = tshow a
 
 addTime ::
-  T.Builder ->
+  LogData ->
-  T.Builder ->
+  LogData ->
-  T.Builder
+  LogData
-addTime t msg = (" [" :: T.Builder) <> t <> ("] " :: T.Builder) <> toLog msg
+addTime t msg = " [" <> t <> "] " <> msg
 
 --- Helpers
-tshow :: Show a => a -> Text
+tshow :: (Show a) => a -> Text
 tshow = T.pack . show
+
+logStr :: (StringConv a Text) => a -> LogData
+logStr t = LogData (T.fromText $ toS t)
+
+ls :: (StringConv a Text) => a -> LogData
+ls = logStr