hello

.gitignore

@@ -1,3 +1,5 @@
 .stack-work/
 *~
 .direnv
+.vscode
+git

README.md

@@ -1,2 +1,3 @@
 # git_activity_tracker
 
+Kurwa much

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

package.yaml

@@ -21,6 +21,12 @@ description:         Please see the README on GitHub at <https://github.com/gith
 
 dependencies:
 - base >= 4.7 && < 5
+- typed-process
+- chronos
+- text
+- bytestring
+- aeson
+- wl-pprint-text
 
 ghc-options:
 - -Wall

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
+      ]