diff options
| -rw-r--r-- | Command/MetaData.hs | 13 | ||||
| -rw-r--r-- | Messages/JSON.hs | 57 | ||||
| -rw-r--r-- | Types/Key.hs | 11 |
3 files changed, 45 insertions, 36 deletions
diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 66469f2fc..d33372d0b 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -10,7 +10,7 @@ module Command.MetaData where import Command import Annex.MetaData import Logs.MetaData -import Messages.JSON (ParsedJSON(..)) +import Messages.JSON (JSONActionItem(..)) import qualified Data.Set as S import qualified Data.Text as T @@ -131,6 +131,11 @@ fieldsField = T.pack "fields" parseJSONInput :: String -> Maybe (Either FilePath Key, MetaData) parseJSONInput i = do v <- decode (BU.fromString i) - case parsedAdded v of - Nothing -> return (parsedKeyfile v, emptyMetaData) - Just (MetaDataFields m) -> return (parsedKeyfile v, m) + let m = case itemAdded v of + Nothing -> emptyMetaData + Just (MetaDataFields m') -> m' + let keyfile = case (itemKey v, itemFile v) of + (Just k, _) -> Right k + (Nothing, Just f) -> Left f + (Nothing, Nothing) -> error "JSON input is missing either file or key" + return (keyfile, m) diff --git a/Messages/JSON.hs b/Messages/JSON.hs index b45c9eff8..70de0739a 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -15,7 +15,7 @@ module Messages.JSON ( complete, DualDisp(..), ObjectMap(..), - ParsedJSON(..), + JSONActionItem(..), ) where import Data.Aeson @@ -25,17 +25,16 @@ import qualified Data.Text as T import qualified Utility.JSONStream as Stream import Types.Key -import Data.Maybe start :: String -> Maybe FilePath -> Maybe Key -> IO () -start command file key = putStr $ Stream.start $ Stream.JSONChunk $ catMaybes - [ part "command" (Just command) - , part "file" file - , part "key" (fmap key2file key) - ] +start command file key = putStr $ Stream.start $ Stream.AesonObject o where - part _ Nothing = Nothing - part l (Just v) = Just (l, v) + Object o = toJSON $ JSONActionItem + { itemCommand = Just command + , itemKey = key + , itemFile = file + , itemAdded = Nothing + } end :: Bool -> IO () end b = putStr $ Stream.add (Stream.JSONChunk [("success", b)]) ++ Stream.end @@ -71,33 +70,29 @@ instance ToJSON a => ToJSON (ObjectMap a) where where go (k, v) = (T.pack k, toJSON v) --- An Aeson parser for the JSON output by this module, and --- similar JSON input from users. -data ParsedJSON a = ParsedJSON - { parsedCommand :: Maybe String -- optional - , parsedKeyfile :: Either FilePath Key -- key is preferred - , parsedNote :: Maybe String -- optional - , parsedSuccess :: Bool -- optional, defaults to True - , parsedAdded :: Maybe a -- to parse additional fields added by `add` +-- An item that a git-annex command acts on, and displays a JSON object about. +data JSONActionItem a = JSONActionItem + { itemCommand :: Maybe String + , itemKey :: Maybe Key + , itemFile :: Maybe FilePath + , itemAdded :: Maybe a -- for additional fields added by `add` } deriving (Show) -instance FromJSON a => FromJSON (ParsedJSON a) where - parseJSON (Object v) = ParsedJSON +instance ToJSON (JSONActionItem a) where + toJSON i = object + [ "command" .= itemCommand i + , "key" .= (toJSON (itemKey i)) + , "file" .= itemFile i + -- itemAdded is not included; must be added later by 'add' + ] + +instance FromJSON a => FromJSON (JSONActionItem a) where + parseJSON (Object v) = JSONActionItem <$> (v .:? "command") - <*> parsekeyfile - <*> (v .:? "note") - <*> (v .:? "success" .!= True) + <*> (maybe (return Nothing) parseJSON =<< (v .:? "key")) + <*> (v .:? "file") <*> parseadded where - parsekeyfile = do - mks <- v .:? "key" - case file2key =<< mks of - Just k -> return (Right k) - Nothing -> do - mf <- v .:? "file" - case mf of - Just f -> return (Left f) - Nothing -> fail "missing key or file" parseadded = (Just <$> parseJSON (Object v)) <|> return Nothing parseJSON _ = mempty diff --git a/Types/Key.hs b/Types/Key.hs index 8c1828c7e..3642eca1c 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -1,6 +1,6 @@ {- git-annex Key data type - - - Copyright 2011-2014 Joey Hess <id@joeyh.name> + - Copyright 2011-2016 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -21,6 +21,8 @@ module Types.Key ( ) where import System.Posix.Types +import Data.Aeson +import qualified Data.Text as T import Common import Utility.QuickCheck @@ -120,6 +122,13 @@ file2key s _ -> return k addfield _ _ _ = Nothing +instance ToJSON Key where + toJSON = toJSON . key2file + +instance FromJSON Key where + parseJSON (String t) = maybe mempty pure $ file2key $ T.unpack t + parseJSON _ = mempty + instance Arbitrary Key where arbitrary = Key <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t") |