Use RIO as our Prelude

Author: pbrisbin

app/main.hs

@@ -1,5 +1,7 @@
 module Main (main) where
 
+import Prelude
+
 import Restyler.CLI (restylerCLI)
 
 main :: IO ()

package.yaml

@@ -2,9 +2,60 @@ name: restyler
 version: 0.1.0.0
 license: MIT
 
-# Dependencies shared in *all* targets
+default-extensions:
+  - AutoDeriveTypeable
+  - BangPatterns
+  - BinaryLiterals
+  - ConstraintKinds
+  - DataKinds
+  - DefaultSignatures
+  - DeriveDataTypeable
+  - DeriveFoldable
+  - DeriveFunctor
+  - DeriveGeneric
+  - DeriveTraversable
+  - DoAndIfThenElse
+  - EmptyDataDecls
+  - ExistentialQuantification
+  - FlexibleContexts
+  - FlexibleInstances
+  - FunctionalDependencies
+  - GADTs
+  - GeneralizedNewtypeDeriving
+  - InstanceSigs
+  - KindSignatures
+  - LambdaCase
+  - MonadFailDesugaring
+  - MultiParamTypeClasses
+  - MultiWayIf
+  - NamedFieldPuns
+  - NoImplicitPrelude
+  - OverloadedStrings
+  - PartialTypeSignatures
+  - PatternGuards
+  - PolyKinds
+  - RankNTypes
+  - RecordWildCards
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TupleSections
+  - TypeFamilies
+  - TypeSynonymInstances
+  - ViewPatterns
+
+ghc-options:
+  -Wall
+  -Wcompat
+  -Widentities
+  -Wincomplete-record-updates
+  -Wincomplete-uni-patterns
+  -Wpartial-fields
+  -Wredundant-constraints
+
 dependencies:
   - base
+  - rio
+
 
 library:
   source-dirs: src
@@ -41,11 +92,6 @@ library:
     - unordered-containers
     - vector
     - yaml
-  default-extensions:
-    # I don't like putting extensions in the packaging and prefer to see them in
-    # the modules where they are used. However, this extension must be here to
-    # avoid forgetting it and nudge me to use Restyler.Prelude everywhere.
-    - NoImplicitPrelude
 
 executables:
   restyler:

src/Restyler/App/Class.hs

@@ -22,9 +22,6 @@ module Restyler.App.Class
 import Restyler.Prelude
 
 import Conduit (runResourceT, sinkFile)
-import qualified Data.Text as T
-import qualified Data.Text.IO as T
-import qualified Data.Vector as V
 import GitHub.Endpoints.Issues.Comments hiding (comment, comments)
 import GitHub.Endpoints.Issues.Labels
 import GitHub.Endpoints.PullRequests hiding (pullRequest)
@@ -34,7 +31,9 @@ import GitHub.Request
 import Network.HTTP.Client.TLS
 import Network.HTTP.Simple hiding (Request)
 import Restyler.App.Type
-import qualified System.Directory as Directory
+import qualified RIO.Directory as Directory
+import qualified RIO.Text as T
+import qualified RIO.Vector as V
 import qualified System.Exit as Exit
 import qualified System.Process as Process
 
@@ -91,7 +90,7 @@ instance MonadIO m => MonadApp (AppT m) where
 
     readFile path = do
         logDebugN $ "readFile: " <> tshow path
-        appIO SystemError $ T.readFile path
+        appIO SystemError $ readFileUtf8 path
 
     exitSuccess = do
         logDebugN "exitSuccess"
@@ -107,9 +106,9 @@ instance MonadIO m => MonadApp (AppT m) where
         logDebugN $ pack $ "call: " <> cmd <> " " <> show args
         appIO SystemError $ Process.callProcess cmd args
 
-    readProcess cmd args stdin = do
+    readProcess cmd args stdin' = do
         logDebugN $ pack $ "read: " <> cmd <> " " <> show args
-        output <- appIO SystemError $ Process.readProcess cmd args stdin
+        output <- appIO SystemError $ Process.readProcess cmd args stdin'
         output <$ logDebugN ("output: " <> pack output)
 
     downloadFile url path = do

src/Restyler/App/Type.hs

@@ -14,6 +14,7 @@ module Restyler.App.Type
 
 import Restyler.Prelude
 
+import Control.Monad.Logger (LoggingT)
 import qualified Data.Yaml as Yaml
 import Restyler.Config
 import Restyler.Options

src/Restyler/CLI.hs

@@ -16,8 +16,6 @@ import Restyler.Options
 import Restyler.PullRequest.Status
 import Restyler.Setup
 import System.Exit (die)
-import System.IO (BufferMode(..), hSetBuffering, stderr, stdout)
-import System.IO.Temp (withSystemTempDirectory)
 
 -- | The main entrypoint for the restyler CLI
 --
@@ -34,14 +32,14 @@ restylerCLI = do
     hSetBuffering stderr LineBuffering
 
     options <- parseOptions
-    withTempDirectory $ \path -> runExceptT $ do
+    withRestylerDirectory $ \path -> runExceptT $ do
         app <- bootstrapApp options path restylerSetup
         runApp app $ restylerMain `catchError` \ex -> do
             traverse_ (sendPullRequestStatus_ . ErrorStatus) $ oJobUrl options
             throwError ex
 
-withTempDirectory :: (FilePath -> IO (Either AppError a)) -> IO a
-withTempDirectory f = do
+withRestylerDirectory :: (FilePath -> IO (Either AppError a)) -> IO a
+withRestylerDirectory f = do
     result <- tryIO $ withSystemTempDirectory "restyler-" f
     innerResult <- either (dieAppError . SystemError) pure result
     either dieAppError pure innerResult

src/Restyler/Config/ExpectedKeys.hs

@@ -56,7 +56,7 @@ validateExpectedKeyBy label f as k = note msg $ find ((== k) . f) as
         )
 
 nearestElem :: String -> [String] -> Maybe (String, Int)
-nearestElem x = minimumBy (compare `on` snd) . map (id &&& editDistance x)
+nearestElem x = minimumByMaybe (compare `on` snd) . map (id &&& editDistance x)
 
 editDistance :: String -> String -> Int
 editDistance = levenshteinDistance defaultEditCosts

src/Restyler/Config/Interpreter.hs

@@ -31,7 +31,7 @@ instance ToJSON Interpreter where
 -- | Does that path start with a /shebang/ for the given @'Interpreter'@
 hasInterpreter :: Text -> Interpreter -> Bool
 contents `hasInterpreter` interpreter = fromMaybe False $ do
-    line <- headMay $ T.lines contents
+    line <- headMaybe $ T.lines contents
     foundInterpreter <- parseInterpreter . unpack $ T.strip line
     pure $ foundInterpreter == interpreter
 

src/Restyler/Logger.hs

@@ -11,6 +11,8 @@ module Restyler.Logger
 
 import Restyler.Prelude hiding (takeWhile)
 
+import Control.Monad.Logger
+    (LoggingT, defaultLogStr, filterLogger, runLoggingT, runStdoutLoggingT)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Restyler.App

src/Restyler/Prelude.hs

@@ -4,81 +4,35 @@ module Restyler.Prelude
     )
 where
 
---------------------------------------------------------------------------------
--- Safe(r) re-exports
---------------------------------------------------------------------------------
-import Prelude as X hiding
-    (head, init, last, maximum, minimum, pred, read, readFile, succ, tail)
+import RIO as X hiding (LogLevel(..), first, second)
 
-import Control.Applicative as X ((<|>))
-import Control.Arrow as X ((&&&), (***))
 import Control.Error.Util as X (hush, note)
-import Control.Exception.Safe as X
-import Control.Monad as X
 import Control.Monad.Except as X
-import Control.Monad.Logger as X
-import Control.Monad.Reader as X
-import Data.Bifunctor as X
-import Data.Char as X (isSpace)
-import Data.Foldable as X hiding (maximumBy, minimumBy)
-import Data.List as X
-    (dropWhileEnd, find, foldl', isInfixOf, isPrefixOf, isSuffixOf)
-import Data.Maybe as X hiding (fromJust)
-import Data.Proxy as X
-import Data.Semigroup as X ((<>))
-import Data.Text as X (Text, pack, strip, unpack)
-import Data.Text.Encoding as X
-import Data.Traversable as X
-import Data.Vector as X (Vector)
-import Data.Void as X
-import GHC.Generics as X
-import GHC.Stack as X
+import Data.Bifunctor as X (first, second)
 import GitHub.Data as X hiding (command)
-import Safe as X
+import RIO.Char as X (isSpace)
+import RIO.List as X (dropWhileEnd, find, headMaybe, minimumByMaybe)
+import RIO.Text as X (encodeUtf8, pack, unpack)
+import Safe as X (fromJustNote)
+
+-- TODO: Move to RIO and its own logging facilities
+import Control.Monad.Logger as X
+    (LogLevel(..), MonadLogger, logDebugN, logErrorN, logInfoN, logWarnN)
 
 --------------------------------------------------------------------------------
 -- Globally-useful utilities
 --------------------------------------------------------------------------------
-import qualified Data.Foldable as F
-import qualified Data.Text as T
+import qualified RIO.Text as T
 
--- | @'when'@ with a monadic condition
---
--- > x <- someMonadicConditional
--- > when x $ do
--- >     someMonadicAction
--- >
--- > whenM someMonadicConditional someMonadicAction
---
-whenM :: Monad m => m Bool -> m () -> m ()
-whenM condition action = do
-    result <- condition
-    when result action
-
--- | Same for @'unless'@
-unlessM :: Monad m => m Bool -> m () -> m ()
-unlessM condition action = do
-    result <- condition
-    unless result action
-
--- | @'Show'@ as @'Text'@
-tshow :: Show a => a -> Text
-tshow = T.pack . show
+decodeUtf8 :: ByteString -> Text
+decodeUtf8 = T.decodeUtf8With T.lenientDecode
 
 infixl 4 <$$>
 
 -- | @'fmap'@ for doubly-wrapped values
 (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 f <$$> a = fmap f <$> a
 
-minimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
-minimumBy _ [] = Nothing
-minimumBy f xs = Just $ F.minimumBy f xs
-
-maximumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
-maximumBy _ [] = Nothing
-maximumBy f xs = Just $ F.maximumBy f xs
-
 -- | Strip whitespace from the end of a @'Text'@
 chomp :: Text -> Text
 chomp = T.dropWhileEnd isSpace

src/Restyler/PullRequest.hs

@@ -76,7 +76,7 @@ pullRequestIsClosed = (== StateClosed) . pullRequestState
 pullRequestIsFork :: PullRequest -> Bool
 pullRequestIsFork = (/=) <$> pullRequestHeadRepo <*> pullRequestBaseRepo
 
-pullRequestIsNonDefaultBranch :: HasCallStack => PullRequest -> Bool
+pullRequestIsNonDefaultBranch :: PullRequest -> Bool
 pullRequestIsNonDefaultBranch =
     (/=) <$> pullRequestBaseRef <*> pullRequestDefaultBranch