implement forced update

README.md

@@ -6,8 +6,9 @@ With `stack exec -- gitallup-exe --help` to see this text:
   ~~~~
   Update all GIT repos in directory
 
-  Usage: gitallup [--version] [--help] [-p|--path PATH] [-r|--recursive]
-                  [-d|--depth NUMBER] [-m|--master] [-v|--verbose]
+  Usage: gitallup-exe [--version] [--help] [-p|--path PATH] [-r|--recursive] 
+                      [-d|--depth NUMBER] [-m|--master] [-f|--force] 
+                      [-x|--exclude LIST] [-v|--verbose]
     Walks through all subdirectories of the given or current directory, and
     performs git pull on all GIT repos
 
@@ -20,12 +21,11 @@ With `stack exec -- gitallup-exe --help` to see this text:
                             GIT repos?
     -d,--depth NUMBER        The depth of directory recursion (default: -1)
     -m,--master              Switch all to master branch?
-    -f,--force               Force update overriding any local changes (not yet
-                            implemented)?
+    -f,--force               Force update overriding any local changes?
     -x,--exclude LIST        List of directories/repositories to be excluded from
                             updating, comma separated
     -v,--verbose             Verbose output?
-    ~~~~  
+    ~~~~
 
 ## Run tests
 

app/Main.hs

@@ -82,7 +82,7 @@ force =
   switch
     ( long "force"
         <> short 'f'
-        <> help "Force update overriding any local changes (not yet implemented)?"
+        <> help "Force update overriding any local changes?"
     )
 
 exclude :: Parser String

src/Logging.hs

@@ -6,22 +6,23 @@ module Logging
   )
 where
 
-import           RIO
+import           RIO                     hiding ( force )
 import           Types
 
-logInput :: Bool -> Int -> Bool -> FilePath -> String -> RIO App ()
-logInput recursive depth master exclude path =
+logInput :: Bool -> Int -> Bool -> Bool -> FilePath -> String -> RIO App ()
+logInput recursive depth master force exclude path =
   logInfo
     . fromString
     . concat
-    $ [ "Updating "
+    $ [ mkStrUpdate force
       , mkStrRecursive recursive depth
       , mkStrMaster master
       , "GIT repos in "
       , _resolvePath path
       , mkStrExclude exclude
       ]
  where
+  mkStrUpdate f = if f then "Force updating " else "Updating "
   mkStrRecursive r d = if r then "recursively " ++ mkStrDepth d else " "
   mkStrDepth d = if d > -1 then "up to a depth of " ++ show d else " "
   mkStrMaster m = if m then "master branches of the " else " "

src/Run.hs

@@ -6,13 +6,18 @@ module Run
   )
 where
 
+import qualified Data.ByteString.Lazy          as B
+import qualified Data.ByteString.Lazy.Char8    as C8
 import           Control.Monad.Extra            ( ifM
                                                 , partitionM
                                                 )
+import           Data.List                      ( head
+                                                , isPrefixOf
+                                                )
 import           Data.List.Split
 import           Git
 import           Logging
-import           RIO
+import           RIO                     hiding ( force )
 import           System.Directory               ( doesDirectoryExist
                                                 , listDirectory
                                                 , makeAbsolute
@@ -27,9 +32,11 @@ run = do
   recursive <- view recursiveL
   depth     <- view recursiveDepthL
   master    <- view masterL
+  force     <- view forceL
   exclude   <- view excludeL
-  logInput recursive depth master exclude root
-  listRepos recursive depth (splitOn "," exclude) root >>= updateRepos master
+  logInput recursive depth master force exclude root
+  listRepos recursive depth (splitOn "," exclude) root
+    >>= updateRepos master force
 
 listRepos :: Bool -> Int -> [String] -> FilePath -> RIO App [FilePath]
 listRepos recursive depth excluded root = do
@@ -57,16 +64,39 @@ listNestedRepos recursive depth excluded subdirs
   | otherwise
   = return []
 
-updateRepos :: Bool -> [FilePath] -> RIO App ()
-updateRepos master = mapM_ (updateRepo master)
+updateRepos :: Bool -> Bool -> [FilePath] -> RIO App ()
+updateRepos master force = mapM_ (updateRepo master force)
 
-updateRepo :: Bool -> FilePath -> RIO App ()
-updateRepo master repo = do
+updateRepo :: Bool -> Bool -> FilePath -> RIO App ()
+updateRepo master force repo = do
   logRepo repo
   liftIO (setCurrentDirectory repo)
+  when force (gitBranch >>= extractBranch >>= gitResetHard)
   gitPull
   when master (gitBranch >>= processBranch)
 
+extractBranch :: ReadProcessResult -> RIO App B.ByteString
+extractBranch (ExitSuccess     , out, _  ) = return
+  ( C8.pack
+  . drop 2 -- remove "* " from branch name
+  . head -- GIT always returns the active branch prefixed with "* "
+  . filter ("* " `isPrefixOf`)
+  . lines
+  . C8.unpack
+  $ out
+  )
+extractBranch (ExitFailure code, _  , err) = do
+  logWarn
+    . fromString
+    . concat
+    $ [ "Failed extracting branch: "
+      , show code
+      , " - "
+      , show err
+      , "\nReturning 'master'..."
+      ]
+  return "master"
+
 processBranch :: ReadProcessResult -> RIO App ()
 processBranch (ExitSuccess, out, _) = unless (isMasterBranch out) $ do
   logInfo . fromString $ "Checkout and update master branch"

src/Types.hs

@@ -38,6 +38,9 @@ class HasRecursiveDepth env where
 class HasMaster env where
   masterL :: Lens' env Bool
 
+class HasForce env where
+  forceL :: Lens' env Bool
+
 class HasExclude env where
   excludeL :: Lens' env String
 
@@ -68,6 +71,12 @@ instance HasMaster App where
     appOptionsL    = lens appOptions (\x y -> x { appOptions = y })
     optionsMasterL = lens optionsMaster (\x y -> x { optionsMaster = y })
 
+instance HasForce App where
+  forceL = appOptionsL . optionsForceL
+   where
+    appOptionsL   = lens appOptions (\x y -> x { appOptions = y })
+    optionsForceL = lens optionsForce (\x y -> x { optionsForce = y })
+
 instance HasExclude App where
   excludeL = appOptionsL . optionsExcludeL
    where