Skip to content
Permalink
Browse files

Use RIO as our Prelude

  • Loading branch information...
pbrisbin committed Apr 11, 2019
1 parent 0cc0f44 commit 2a7fe7a8def6c9d337133671f784a743ef7b68ec
@@ -1,5 +1,7 @@
module Main (main) where

import Prelude

import Restyler.CLI (restylerCLI)

main :: IO ()
@@ -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:
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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

@@ -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
@@ -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
@@ -76,7 +76,7 @@ pullRequestIsClosed = (== StateClosed) . pullRequestState
pullRequestIsFork :: PullRequest -> Bool
pullRequestIsFork = (/=) <$> pullRequestHeadRepo <*> pullRequestBaseRepo

pullRequestIsNonDefaultBranch :: HasCallStack => PullRequest -> Bool
pullRequestIsNonDefaultBranch :: PullRequest -> Bool
pullRequestIsNonDefaultBranch =
(/=) <$> pullRequestBaseRef <*> pullRequestDefaultBranch

@@ -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
@@ -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)
@@ -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
@@ -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)

0 comments on commit 2a7fe7a

Please sign in to comment.
You can’t perform that action at this time.