s/RIO/Relude + Blammo/

app/Main.hs

@@ -3,8 +3,9 @@ module Main
   )
 where
 
-import RIO
+import Relude
 
+import Blammo.Logging.Simple
 import Data.Version (showVersion)
 import Options.Applicative
 import Paths_whitespace qualified as Pkg
@@ -14,9 +15,9 @@ main :: IO ()
 main = do
   opts <- execParser $ info (options <**> helper) fullDesc
 
-  runSimpleApp $ do
+  runSimpleLoggingT $ do
     if opts.showVersion
-      then logInfo $ "whitespace " <> fromString (showVersion Pkg.version)
+      then putStrLn $ "whitespace " <> showVersion Pkg.version
       else formatPaths opts.formatOptions
 
 data Options = Options

package.yaml

@@ -4,7 +4,6 @@ license: MIT
 
 dependencies:
   - base >= 4.11 && < 5
-  - rio # TODO
 
 ghc-options:
   - -Weverything
@@ -36,6 +35,10 @@ default-extensions:
 
 library:
   source-dirs: src
+  dependencies:
+    - Blammo
+    - relude
+    - unliftio
 
 executables:
   whitespace:
@@ -46,7 +49,9 @@ executables:
       - -rtsopts
       - -with-rtsopts=-N
     dependencies:
+      - Blammo
       - optparse-applicative
+      - relude
       - whitespace
 
 tests:
@@ -59,4 +64,6 @@ tests:
       - -with-rtsopts=-N
     dependencies:
       - hspec
+      - monad-logger
+      - relude
       - whitespace

src/Whitespace.hs

@@ -8,10 +8,14 @@ module Whitespace
   )
 where
 
-import RIO
+import Relude
 
-import RIO.Char (isSpace)
-import RIO.Text qualified as T
+import Blammo.Logging
+import Blammo.Logging.ThreadContext
+import Data.Char (isSpace)
+import Data.Text qualified as T
+import UnliftIO (MonadUnliftIO)
+import UnliftIO.Exception (handleAny, throwIO)
 
 data FormatOptions = FormatOptions
   { spaces :: Bool
@@ -25,25 +29,25 @@ data FormatOptions = FormatOptions
   }
 
 formatPaths
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+  :: (MonadLogger m, MonadMask m, MonadUnliftIO m)
   => FormatOptions
   -> m ()
 formatPaths opts = for_ opts.paths $ \path ->
   handleAny (handleErr opts.strict path) $ formatPath opts path
 
 data UnableToFormat
   = UnableToFormatCRLF
-  | -- | Most likely non-Utf8
-    UnableToRead SomeException
+  | UnableToRead UnicodeException
   deriving stock (Show)
   deriving anyclass (Exception)
 
 formatPath :: MonadUnliftIO m => FormatOptions -> FilePath -> m ()
 formatPath opts path = do
-  content <- readFileUtf8 path `catchAny` (throwIO . UnableToRead)
+  result <- decodeUtf8Strict <$> readFileBS path
+  content <- either (throwIO . UnableToRead) pure result
   if isCRLF content
     then throwIO UnableToFormatCRLF
-    else writeFileUtf8 path $ format opts content
+    else writeFileText path $ format opts content
 
 isCRLF :: Text -> Bool
 isCRLF = ("\r\n" `T.isInfixOf`)
@@ -67,20 +71,19 @@ eachLine :: (Text -> Text) -> Text -> Text
 eachLine f = T.unlines . map f . T.lines
 
 handleErr
-  :: (MonadIO m, MonadReader env m, HasLogFunc env, Display ex)
+  :: (Exception ex, MonadIO m, MonadLogger m, MonadMask m)
   => Bool
   -> FilePath
   -> ex
   -> m ()
-handleErr strict path ex
-  | strict =
-      do
-        logError
-          $ "Exception processing "
-          <> fromString path
-          <> ":"
-          <> display ex
-          <> ", aborting (disable strict mode to ignore)"
-        exitWith $ ExitFailure 1
-  | otherwise =
-      logWarn $ "Exception processing " <> fromString path <> ":" <> display ex
+handleErr strict path ex = withThreadContext ctx $ do
+  if strict
+    then do
+      logError "Exception processing file, aborting (disable strict mode to ignore)"
+      exitFailure
+    else logWarn "Exception processing file"
+ where
+  ctx =
+    [ "path" .= path
+    , "exception" .= displayException ex
+    ]

test/WhitespaceSpec.hs

@@ -5,8 +5,9 @@ module WhitespaceSpec
   )
 where
 
-import RIO
+import Relude
 
+import Control.Monad.Logger (runNoLoggingT)
 import Test.Hspec
 import Whitespace
 
@@ -24,7 +25,7 @@ spec = do
     it "doesn't incorrectly format non-utf8" $ do
       let path = "test/fixtures/non-utf8.yaml"
 
-      runSimpleApp (formatPath opts path) `shouldThrow` \case
+      runNoLoggingT (formatPath opts path) `shouldThrow` \case
         UnableToRead _ -> True
         _ -> False
 

whitespace.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: da0292cd6e405f0a5588ce3bb2c4955fd33ae873f3e27fc08e35b7437dbb9c01
+-- hash: 7a6c71819d1c4d2b39f2366c1c1332010af0bc17408d0af5d4716c8fc23df04f
 
 name:           whitespace
 version:        0.2.0.0
@@ -37,8 +37,10 @@ library
       TypeFamilies
   ghc-options: -Weverything -Wno-missing-import-lists -Wno-missing-kind-signatures -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations -Wno-missing-safe-haskell-mode -Wno-unsafe
   build-depends:
-      base >=4.11 && <5
-    , rio
+      Blammo
+    , base >=4.11 && <5
+    , relude
+    , unliftio
   default-language: GHC2021
 
 executable whitespace
@@ -65,9 +67,10 @@ executable whitespace
       TypeFamilies
   ghc-options: -Weverything -Wno-missing-import-lists -Wno-missing-kind-signatures -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations -Wno-missing-safe-haskell-mode -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.11 && <5
+      Blammo
+    , base >=4.11 && <5
     , optparse-applicative
-    , rio
+    , relude
     , whitespace
   default-language: GHC2021
 
@@ -99,6 +102,7 @@ test-suite whitespace-test
   build-depends:
       base >=4.11 && <5
     , hspec
-    , rio
+    , monad-logger
+    , relude
     , whitespace
   default-language: GHC2021