arguments

flake.nix

@@ -36,6 +36,7 @@
                 hPkgs.haskell-language-server
                 hPkgs.ghc
                 stack-wrapper
+                pkgs.glibcLocales
               ];
             };
           }

git-activity-tracker.cabal

@@ -38,6 +38,8 @@ library
     , base >=4.7 && <5
     , bytestring
     , chronos
+    , extra
+    , optparse-applicative
     , text
     , typed-process
     , wl-pprint-text
@@ -57,7 +59,9 @@ executable git-activity-tracker-exe
     , base >=4.7 && <5
     , bytestring
     , chronos
+    , extra
     , git-activity-tracker
+    , optparse-applicative
     , text
     , typed-process
     , wl-pprint-text
@@ -78,7 +82,9 @@ test-suite git-activity-tracker-test
     , base >=4.7 && <5
     , bytestring
     , chronos
+    , extra
     , git-activity-tracker
+    , optparse-applicative
     , text
     , typed-process
     , wl-pprint-text

package.yaml

@@ -27,6 +27,8 @@ dependencies:
 - bytestring
 - aeson
 - wl-pprint-text
+- optparse-applicative
+- extra
 
 ghc-options:
 - -Wall

src/Lib.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
 module Lib
     ( libMain
     ) where
@@ -13,8 +14,14 @@ import GHC.Generics (Generic)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import Data.Char (toLower)
-import Text.PrettyPrint.Leijen.Text
+import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 import qualified Data.Aeson.Types as A
+import qualified Options.Applicative as O
+import Data.Either.Extra
+import Control.Monad
+import qualified Data.Text.Encoding as T
+import Data.Functor
+import Data.Function
 
 updateHead :: (a -> a) -> [a] -> [a]
 updateHead fun (x:xs) = fun x : xs
@@ -22,6 +29,111 @@ updateHead _ [] = []
 
 data Commit = Commit{_cDate :: Datetime, _cHash :: Text, _cAuthor :: Text, _cMessage :: Text} deriving (Generic, Show)
 
+data Arguments = Arguments
+  { _aStateDir :: Text
+  , _aVerbose :: Bool
+  , _aCommand :: Command
+  }
+  deriving Show
+
+data Command
+  = CommandAdd
+  { _caURL :: Text
+  }
+  | CommandRemove
+  { _crURL :: Text
+  }
+  | CommandCommits
+  { _ccFrom :: Maybe Datetime
+  , _ccTo :: Maybe Datetime
+  , _ccAuthors :: [Text]
+  }
+  | CommandGenGraph
+  { _cgFrom :: Maybe Datetime
+  , _cgTo :: Maybe Datetime
+  , _cgAuthors :: [Text]
+  }
+  deriving Show
+
+datetime :: O.ReadM Datetime
+datetime = O.eitherReader $ \str -> 
+  case decode_YmdHMS_lenient (T.pack str) of
+    Just date -> Right date
+    Nothing -> case decode_YmdHMS_lenient (T.pack str <> " 00:00:00") of
+      Just date -> Right date
+      Nothing -> Left "Invalid datetime"
+
+commandAdd :: O.Parser Command
+commandAdd
+    = CommandAdd
+  <$> O.argument O.str (O.metavar "URL")
+
+commandRemove :: O.Parser Command
+commandRemove
+   = CommandRemove
+  <$> O.argument O.str (O.metavar "URL")
+
+commandCommits :: O.Parser Command 
+commandCommits 
+    = CommandCommits 
+  <$> O.optional 
+      ( O.option datetime
+        ( O.long "from" 
+        <> O.metavar "DATE")
+      )
+  <*> O.optional
+      ( O.option datetime
+        ( O.long "to"
+        <> O.metavar "DATE"
+        )
+      )
+  <*> O.many 
+      ( O.strOption 
+        ( O.long "author"
+        <> O.metavar "NAME"
+        )
+      )
+
+commandGenGraph :: O.Parser Command 
+commandGenGraph
+    = CommandGenGraph 
+  <$> O.optional 
+      ( O.option datetime
+        ( O.long "from" 
+        <> O.metavar "DATE")
+      )
+  <*> O.optional
+      ( O.option datetime
+        ( O.long "to"
+        <> O.metavar "DATE"
+        )
+      )
+  <*> O.many 
+      ( O.strOption 
+        ( O.long "author"
+        <> O.metavar "NAME"
+        )
+      )
+
+arguments :: O.Parser Arguments
+arguments 
+      = Arguments
+    <$> O.strOption
+        ( O.long "state-dir"
+        <> O.metavar "STATE_DIR"
+        )
+    <*> O.switch
+        ( O.long "verbose"
+        <> O.short 'v'
+        )
+    <*> O.subparser
+        ( O.command "add" (O.info (commandAdd O.<**> O.helper) ( O.progDesc "Add a remote for tracking" ))
+        <> O.command "remove" (O.info (commandRemove O.<**> O.helper) ( O.progDesc "Remove a remote from tracking"))
+        <> O.command "commits" (O.info (commandCommits O.<**> O.helper) ( O.progDesc "Print commits"))
+        <> O.command "gen-graph" (O.info (commandGenGraph O.<**> O.helper) ( O.progDesc "Generate graph"))
+        )
+    
+
 commitOptions :: A.Options
 commitOptions = (A.defaultOptions { A.fieldLabelModifier = updateHead toLower . drop 2})
 
@@ -38,31 +150,44 @@ prettyCommit (Commit {_cDate, _cHash, _cAuthor, _cMessage})
     = textStrict (encode_YmdHMS (SubsecondPrecisionFixed 0) hyphen _cDate)
   <+> textStrict _cAuthor
   <+> textStrict _cHash
-  <+> textStrict ("\"" <> _cMessage <> "\"")
+  <+> textStrict ("\"" <> T.replace "\"" "\\\"" _cMessage <> "\"")
 
 libMain :: IO ()
-libMain = do
+libMain = O.execParser (O.info (arguments O.<**> O.helper) (O.progDesc "Git Activity Tracker")) >>= \(Arguments { _aVerbose, _aStateDir, _aCommand }) ->
-  putStrLn "someFunc"
+  case _aCommand of
-  result <- getCommits "magic_rb/dotfiles/master/master" ["magic_rb"] (Just (Datetime (Date (Year 2024) (Month 0) (DayOfMonth 31)) (TimeOfDay 0 0 0)), Nothing)
+    CommandAdd { _caURL } -> pure ()
+    CommandRemove { _crURL } -> pure ()
+    CommandCommits { _ccFrom, _ccTo, _ccAuthors } -> do
+      result <- getCommits _aVerbose "magic_rb/dotfiles/master/master" _ccAuthors (_ccFrom, _ccTo)
+      case result of
+        Left err -> print err
+        Right ok -> mapM_ (print . prettyCommit) ok
+    CommandGenGraph { _cgFrom, _cgTo, _cgAuthors } -> pure ()
 
-  case result of
+  -- do
-    Left err -> print err
+  --putStrLn "someFunc"
-    Right ok -> mapM_ (print . prettyCommit) ok
+  --result <- getCommits "magic_rb/dotfiles/master/master" ["magic_rb"] (Just (Datetime (Date (Year 2024) (Month 0) (DayOfMonth 31)) (TimeOfDay 0 0 0)), Nothing)
 
-getCommits :: String -> [String] -> (Maybe Datetime, Maybe Datetime) -> IO (Either String [Commit])
+  --case result of
-getCommits branch authors (from, to) =
+  --  Left err -> print err
+  --  Right ok -> mapM_ (print . prettyCommit) ok
+
+getCommits :: Bool -> Text -> [Text] -> (Maybe Datetime, Maybe Datetime) -> IO (Either Text [Commit])
+getCommits verbose branch authors (from, to) = do
+  when verbose (putStrLn . unwords $ "git" : args)
   readProcessStdout pc >>= \(exitCode, stdout) ->
     case exitCode of
       ExitFailure _ -> pure $ Left ""
-      ExitSuccess -> pure $ mapM A.eitherDecode (BSL.lines stdout)
+      ExitSuccess ->  pure a
+        where a = T.decodeUtf8' (BSL.toStrict stdout) <&> T.lines <&> map (T.replace "^@^" "\"" . T.replace "\"" "\\\"") & mapLeft show >>= mapM A.eitherDecode' . map (BSL.fromStrict . T.encodeUtf8) & mapLeft T.pack
   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\" }"
+      , "--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 <>
+      ] <> map (\author -> "--author=" <> T.unpack author) authors <>
-      [ branch
+      [ T.unpack branch
       ]