diff options
| -rw-r--r-- | app/Git.hs | 21 | ||||
| -rw-r--r-- | app/IssueEvent.hs | 4 | ||||
| -rw-r--r-- | app/Process.hs | 23 |
3 files changed, 32 insertions, 16 deletions
@@ -22,7 +22,6 @@ import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as N import Data.Maybe (fromMaybe) import Data.Text qualified as T -import Data.Text.Encoding qualified as T import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Encoding qualified as LT import Data.Text.Lazy.IO qualified as LT @@ -35,19 +34,21 @@ import Process (proc, sh, sh_) import Text.Printf (printf) getCommitHashes :: IO (NonEmpty T.Text) -getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB.toStrict <$> sh "git log --format=%H" +getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines <$> sh "git log --format=%H" getRootDir :: IO FilePath -getRootDir = T.unpack . stripTrailingNL . T.decodeUtf8 . LB.toStrict <$> sh (proc "git rev-parse --show-toplevel") +getRootDir = + T.unpack . stripTrailingNL + <$> sh (proc "git rev-parse --show-toplevel") where stripTrailingNL s = fromMaybe s $ T.stripSuffix "\n" s getChangedFilesOf :: CommitHash -> IO [FilePath] -getChangedFilesOf WorkingTree = do - map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict +getChangedFilesOf WorkingTree = + map T.unpack . T.lines <$> sh "git ls-files --modified" -getChangedFilesOf (Commit hash) = do - map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict +getChangedFilesOf (Commit hash) = + map T.unpack . T.lines <$> sh (proc "git show -p --name-only --format= %" hash) data Commit = Commit' @@ -66,15 +67,15 @@ data Author = Author getCommitOf :: CommitHash -> IO Commit getCommitOf commitHash@WorkingTree = do date <- getCurrentTime - authorName <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.name" - authorEmail <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.email" + authorName <- sh "git config user.name" + authorEmail <- sh "git config user.email" pure Commit' { author = Author authorName authorEmail, .. } getCommitOf commitHash@(Commit hash) = do - ( T.splitOn "\NUL" . head . T.lines . T.decodeUtf8 . LB.toStrict + ( T.splitOn "\NUL" . head . T.lines <$> sh ( proc "git show --quiet --format=%%ai%%x00%%ae%%x00%%an %" diff --git a/app/IssueEvent.hs b/app/IssueEvent.hs index 0c641ad..28bbae1 100644 --- a/app/IssueEvent.hs +++ b/app/IssueEvent.hs @@ -10,8 +10,6 @@ import Data.Binary (Binary (..)) import Data.Function ((&)) import Data.Text qualified as T import Data.Text.IO qualified as T -import Data.Text.Lazy qualified as LT -import Data.Text.Lazy.Encoding qualified as LT import GHC.Generics (Generic) import GHC.Records (HasField (..)) import Git.CommitHash (CommitHash) @@ -52,7 +50,7 @@ diff old new = withSystemTempDirectory "diff" $ \tmp -> do let cwd = tmp T.writeFile (tmp </> "old") old T.writeFile (tmp </> "new") new - A.parse . LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd) + A.parse <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd) instance P.Render IssueEvent where render = P.render . P.Detailed diff --git a/app/Process.hs b/app/Process.hs index 2b3eaf6..8df56c5 100644 --- a/app/Process.hs +++ b/app/Process.hs @@ -12,21 +12,23 @@ module Process where import Control.Exception (throwIO) -import Data.ByteString.Lazy.Char8 qualified as LB +import Data.ByteString qualified as B +import Data.ByteString.Lazy qualified as LB import Data.List (intercalate) import Data.String (fromString) import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Encoding qualified as LT import Exception qualified as E import System.Exit (ExitCode (ExitSuccess)) import System.Process.Typed (ProcessConfig, StreamSpec, StreamType (STInput), byteStringInput, readProcess, readProcessStderr) -sh :: ProcessConfig stdin stdoutIgnored stderr -> IO LB.ByteString +sh :: Output a => ProcessConfig stdin stdoutIgnored stderr -> IO a sh processConfig = do (exitCode, out, err) <- readProcess processConfig if exitCode == ExitSuccess - then pure out + then pure (fromLB out) else throwIO $ E.ProcessException (show processConfig) exitCode err sh_ :: ProcessConfig stdin stdoutIgnored stderr -> IO () @@ -36,6 +38,21 @@ sh_ processConfig = do then pure () else throwIO $ E.ProcessException (show processConfig) exitCode err +class Output a where + fromLB :: LB.ByteString -> a + +instance Output LB.ByteString where + fromLB = id + +instance Output B.ByteString where + fromLB = LB.toStrict + +instance Output LT.Text where + fromLB = LT.decodeUtf8 + +instance Output T.Text where + fromLB = T.decodeUtf8 . LB.toStrict + class Quotable a where quote :: a -> String |