Use RIO as our Prelude

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

src/Restyler/PullRequestSpec.hs

@@ -16,7 +16,7 @@ where
import Restyler.Prelude

import qualified Prelude as Unsafe
import Text.Megaparsec
import Text.Megaparsec hiding (some)
import Text.Megaparsec.Char

data PullRequestSpec = PullRequestSpec

test/Restyler/ConfigSpec.hs

@@ -7,7 +7,6 @@ where

import SpecHelper

import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import Data.List (isInfixOf)

test/Restyler/PullRequestSpecSpec.hs

@@ -25,7 +25,3 @@ spec = describe "parseSpec" $ do
    it "round-trips" $ property $ \(owner, name, Positive num) ->
        let prSpec = PullRequestSpec owner name num
        in parseSpec (T.unpack $ showSpec prSpec) == Right prSpec

isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft _ = False

test/SpecHelper.hs

@@ -6,10 +6,12 @@ module SpecHelper
    )
where

import RIO as X hiding (first)

import Data.Bifunctor as X (first)
import Test.Hspec as X

import Data.Char (isSpace)
import Data.Proxy
import qualified Data.Text as T
import Data.Text.Arbitrary ()
import GitHub.Data (Id, Name, mkId, mkName)