diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-07-26 14:10:29 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-07-26 14:10:29 -0400 |
commit | 3e474c0ef81eff9e3fb6b2bf545f2f279e16b1de (patch) | |
tree | 498ef0583a45a68ca06567ca1e4cb189e6c542d8 /Messages/JSON.hs | |
parent | 3eb54bb464b4566e5ea5fe9db5addc20231597d0 (diff) |
aeson parser for --json output lines
Diffstat (limited to 'Messages/JSON.hs')
-rw-r--r-- | Messages/JSON.hs | 44 |
1 files changed, 40 insertions, 4 deletions
diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 6e89693fc..895c251db 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Messages.JSON ( start, end, @@ -12,9 +14,12 @@ module Messages.JSON ( add, complete, DualDisp(..), + ParsedJSON(..), ) where -import Text.JSON +import qualified Text.JSON as JSON +import Data.Aeson +import Control.Applicative import qualified Utility.JSONStream as Stream import Types.Key @@ -48,9 +53,40 @@ data DualDisp = DualDisp , dispJson :: String } -instance JSON DualDisp where - showJSON = JSString . toJSString . dispJson - readJSON _ = Error "stub" +instance JSON.JSON DualDisp where + showJSON = JSON.JSString . JSON.toJSString . dispJson + readJSON _ = JSON.Error "stub" instance Show DualDisp where show = dispNormal + +-- 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` + } + deriving (Show) + +instance FromJSON a => FromJSON (ParsedJSON a) where + parseJSON (Object v) = ParsedJSON + <$> (v .:? "command") + <*> parsekeyfile + <*> (v .:? "note") + <*> (v .:? "success" .!= True) + <*> 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 |