From f081c83abf2eacf61337f9277fb646b66ad95848 Mon Sep 17 00:00:00 2001 From: Starkey Date: Fri, 2 Feb 2024 16:28:33 +0100 Subject: [PATCH] hello --- .gitignore | 2 ++ README.md | 1 + git-activity-tracker.cabal | 24 ++++++++++++++-- package.yaml | 6 ++++ src/Lib.hs | 59 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 89 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index f475e87..a9727ac 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ .stack-work/ *~ .direnv +.vscode +git diff --git a/README.md b/README.md index de4ecd6..a91a412 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,3 @@ # git_activity_tracker +Kurwa much \ No newline at end of file diff --git a/git-activity-tracker.cabal b/git-activity-tracker.cabal index 2a838a4..52d36df 100644 --- a/git-activity-tracker.cabal +++ b/git-activity-tracker.cabal @@ -34,7 +34,13 @@ library src ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: - base >=4.7 && <5 + aeson + , base >=4.7 && <5 + , bytestring + , chronos + , text + , typed-process + , wl-pprint-text default-language: Haskell2010 executable git-activity-tracker-exe @@ -47,8 +53,14 @@ executable git-activity-tracker-exe app ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + aeson + , base >=4.7 && <5 + , bytestring + , chronos , git-activity-tracker + , text + , typed-process + , wl-pprint-text default-language: Haskell2010 test-suite git-activity-tracker-test @@ -62,6 +74,12 @@ test-suite git-activity-tracker-test test ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + aeson + , base >=4.7 && <5 + , bytestring + , chronos , git-activity-tracker + , text + , typed-process + , wl-pprint-text default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 2a8a427..fa3aa58 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,12 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- typed-process +- chronos +- text +- bytestring +- aeson +- wl-pprint-text ghc-options: - -Wall diff --git a/src/Lib.hs b/src/Lib.hs index ee98a8e..3ad7f96 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,7 +1,66 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NamedFieldPuns #-} module Lib ( libMain ) where +import System.Process.Typed +import Chronos +import qualified Data.Text as T +import Data.Text (Text) +import GHC.Generics (Generic) +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Char (toLower) +import Text.PrettyPrint.Leijen.Text + +updateHead :: (a -> a) -> [a] -> [a] +updateHead fun (x:xs) = fun x : xs +updateHead _ [] = [] + +data Commit = Commit{_cDate :: Datetime, _cHash :: Text, _cAuthor :: Text, _cMessage :: Text} deriving (Generic, Show) + +commitOptions :: Options +commitOptions = (defaultOptions { fieldLabelModifier = updateHead toLower . drop 2}) + +instance ToJSON Commit where + toEncoding :: Commit -> Encoding + toEncoding = genericToEncoding commitOptions + +instance FromJSON Commit where + parseJSON = genericParseJSON commitOptions + +prettyCommit :: Commit -> Doc +prettyCommit (Commit {_cDate, _cHash, _cAuthor, _cMessage}) + = textStrict (encode_YmdHMS (SubsecondPrecisionFixed 0) hyphen _cDate) + <+> textStrict _cAuthor + <+> textStrict _cHash + <+> textStrict ("\"" <> _cMessage <> "\"") libMain :: IO () libMain = do putStrLn "someFunc" + result <- getCommits "magic_rb/dotfiles/master/master" ["magic_rb"] (Just (Datetime (Date (Year 2024) (Month 0) (DayOfMonth 31)) (TimeOfDay 0 0 0)), Nothing) + + case result of + Left err -> print err + Right ok -> mapM_ (print . prettyCommit) ok + +getCommits :: String -> [String] -> (Maybe Datetime, Maybe Datetime) -> IO (Either String [Commit]) +getCommits branch authors (from, to) = + readProcessStdout pc >>= \(exitCode, stdout) -> + case exitCode of + ExitFailure _ -> pure $ Left "" + ExitSuccess -> pure $ mapM eitherDecode (BSL.lines stdout) + where + pc = proc "git" args + args = filter (/= "") $ + [ "log" + , "--date=format:%Y-%m-%d %H:%M:%S" + , "--format=format:{ \"date\": \"%ad\", \"hash\": \"%H\", \"author\": \"%an\", \"message\": \"%s\" }" + , maybe "" (\from' -> "--since=" <> T.unpack (encodeIso8601 from')) from + , maybe "" (\to' -> "--before=" <> T.unpack (encodeIso8601 to')) to + ] <> map ("--author=" <>) authors <> + [ branch + ] \ No newline at end of file