1{- git status interface 2 - 3 - Copyright 2015-2018 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8module Git.Status where 9 10import Common 11import Git 12import Git.Command 13import Git.FilePath 14 15data Status 16 = Modified TopFilePath 17 | Deleted TopFilePath 18 | Added TopFilePath 19 | Renamed TopFilePath TopFilePath 20 | TypeChanged TopFilePath 21 | Untracked TopFilePath 22 23data StagedUnstaged a = StagedUnstaged 24 { staged :: Maybe a 25 , unstaged :: Maybe a 26 } 27 28statusChar :: Status -> Char 29statusChar (Modified _) = 'M' 30statusChar (Deleted _) = 'D' 31statusChar (Added _) = 'A' 32statusChar (Renamed _ _) = 'R' 33statusChar (TypeChanged _) = 'T' 34statusChar (Untracked _) = '?' 35 36statusFile :: Status -> TopFilePath 37statusFile (Modified f) = f 38statusFile (Deleted f) = f 39statusFile (Added f) = f 40statusFile (Renamed _oldf newf) = newf 41statusFile (TypeChanged f) = f 42statusFile (Untracked f) = f 43 44parseStatusZ :: [String] -> [StagedUnstaged Status] 45parseStatusZ = go [] 46 where 47 go c [] = reverse c 48 go c (x:xs) = case x of 49 (sstaged:sunstaged:' ':f) -> 50 case (cparse sstaged f xs, cparse sunstaged f xs) of 51 ((vstaged, xs1), (vunstaged, xs2)) -> 52 let v = StagedUnstaged 53 { staged = vstaged 54 , unstaged = vunstaged 55 } 56 xs' = fromMaybe xs (xs1 <|> xs2) 57 in go (v : c) xs' 58 _ -> go c xs 59 60 cparse 'M' f _ = (Just (Modified (asTopFilePath (toRawFilePath f))), Nothing) 61 cparse 'A' f _ = (Just (Added (asTopFilePath (toRawFilePath f))), Nothing) 62 cparse 'D' f _ = (Just (Deleted (asTopFilePath (toRawFilePath f))), Nothing) 63 cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toRawFilePath f))), Nothing) 64 cparse '?' f _ = (Just (Untracked (asTopFilePath (toRawFilePath f))), Nothing) 65 cparse 'R' f (oldf:xs) = 66 (Just (Renamed (asTopFilePath (toRawFilePath oldf)) (asTopFilePath (toRawFilePath f))), Just xs) 67 cparse _ _ _ = (Nothing, Nothing) 68 69getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool) 70getStatus ps fs r = do 71 (ls, cleanup) <- pipeNullSplit ps' r 72 return (parseStatusZ (map decodeBL ls), cleanup) 73 where 74 ps' = concat 75 [ [Param "status"] 76 , ps 77 , [ Param "-uall" , Param "-z"] 78 , map File fs 79 ] 80