mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

--branch, stage 2

Browse source 
Show branch:file that is being operated on.

I had to make ActionItem a type and not a type class because
withKeyOptions' passed two different types of values when using the type
class, and I could not get the type checker to accept that.
This commit is contained in:
Joey Hess 2016-07-20 15:22:55 -04:00
parent 847944e6b1
commit d13194b230
Failed to extract signature
15 changed files with 145 additions and 102 deletions
Download patch file Download diff file Expand all files Collapse all files

52
Messages.hs
View file

@ -9,6 +9,8 @@
module Messages (
showStart,
ActionItem,
mkActionItem,
showStart',
showNote,
showAction,
@ -50,36 +52,50 @@ import System.Log.Handler.Simple
import Common
import Types
import Types.Messages
import Git.FilePath
import Messages.Internal
import qualified Messages.JSON as JSON
import Types.Key
import qualified Annex
showStart :: String -> FilePath -> Annex ()
showStart command file = outputMessage (JSON.start command (Just file) Nothing) $
showStart command file = outputMessage json $
command ++ " " ++ file ++ " "
where
json = JSON.start command (Just file) Nothing
class ActionItem i where
actionItemDesc :: i -> Key -> String
actionItemWorkTreeFile :: i -> Maybe FilePath
data ActionItem
= ActionItemAssociatedFile AssociatedFile
| ActionItemKey
| ActionItemBranchFilePath BranchFilePath
instance ActionItem FilePath where
actionItemDesc f _ = f
actionItemWorkTreeFile = Just
class MkActionItem t where
mkActionItem :: t -> ActionItem
instance ActionItem AssociatedFile where
actionItemDesc (Just f) _ = f
actionItemDesc Nothing k = key2file k
actionItemWorkTreeFile = id
instance MkActionItem AssociatedFile where
mkActionItem = ActionItemAssociatedFile
instance ActionItem Key where
actionItemDesc k _ = key2file k
actionItemWorkTreeFile _ = Nothing
instance MkActionItem Key where
mkActionItem _ = ActionItemKey
showStart' :: ActionItem i => String -> Key -> i -> Annex ()
showStart' command key i =
outputMessage (JSON.start command (actionItemWorkTreeFile i) (Just key)) $
command ++ " " ++ actionItemDesc i key ++ " "
instance MkActionItem BranchFilePath where
mkActionItem = ActionItemBranchFilePath
actionItemDesc :: ActionItem -> Key -> String
actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
actionItemDesc ActionItemKey k = key2file k
actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
actionItemWorkTreeFile _ = Nothing
showStart' :: String -> Key -> ActionItem -> Annex ()
showStart' command key i = outputMessage json $
command ++ " " ++ actionItemDesc i key ++ " "
where
json = JSON.start command (actionItemWorkTreeFile i) (Just key)
showNote :: String -> Annex ()
showNote s = outputMessage (JSON.note s) $ "(" ++ s ++ ") "