diff --git a/aeson-diff.cabal b/aeson-diff.cabal --- a/aeson-diff.cabal +++ b/aeson-diff.cabal @@ -1,5 +1,5 @@ name: aeson-diff -version: 1.1.0.12 +version: 1.1.0.13 synopsis: Extract and apply patches to JSON documents. description: . @@ -46,21 +46,25 @@ default-language: Haskell2010 hs-source-dirs: src main-is: diff.hs + other-modules: Codec build-depends: base , aeson >= 2.0.3 , aeson-diff , bytestring , optparse-applicative + , yaml executable json-patch default-language: Haskell2010 hs-source-dirs: src main-is: patch.hs + other-modules: Codec build-depends: base , aeson >= 2.0.3 , aeson-diff , bytestring , optparse-applicative + , yaml test-suite properties default-language: Haskell2010 diff --git a/src/Codec.hs b/src/Codec.hs new file mode 100644 --- /dev/null +++ b/src/Codec.hs @@ -0,0 +1,37 @@ +module Codec (encode, decode, ForceFormat (..)) where + +import qualified Data.Aeson as Aeson +import qualified Data.Yaml as Yaml +import qualified Data.ByteString.Lazy as BL +import Control.Applicative ((<|>)) +import Data.Char (toLower) +import Data.List (isSuffixOf) + +data ForceFormat = ForceYaml | AutodetectFormat deriving (Show, Eq) + +isYamlPath :: [Char] -> Bool +isYamlPath fn = + ".yaml" `isSuffixOf` map toLower fn + || ".yml" `isSuffixOf` map toLower fn + +isJsonPath :: [Char] -> Bool +isJsonPath fn = + ".json" `isSuffixOf` map toLower fn + +decode :: Aeson.FromJSON a => ForceFormat -> Maybe FilePath -> BL.ByteString -> Maybe a +decode ForceYaml _ = decodeYamlFirst +decode AutodetectFormat (Just fn) | isYamlPath fn = decodeYamlFirst +decode AutodetectFormat (Just fn) | isJsonPath fn = Aeson.decode +decode AutodetectFormat _ = decodeJsonFirst + + +decodeYamlFirst :: Aeson.FromJSON a => BL.ByteString -> Maybe a +decodeYamlFirst s = Yaml.decodeThrow (BL.toStrict s) <|> Aeson.decode s + +decodeJsonFirst :: Aeson.FromJSON a => BL.ByteString -> Maybe a +decodeJsonFirst s = Aeson.decode s <|> Yaml.decodeThrow (BL.toStrict s) + +encode :: Aeson.ToJSON a => ForceFormat -> Maybe FilePath -> a -> BL.ByteString +encode ForceYaml _ = BL.fromStrict . Yaml.encode +encode AutodetectFormat (Just fn) | isYamlPath fn = BL.fromStrict . Yaml.encode +encode AutodetectFormat _ = Aeson.encode diff --git a/src/diff.hs b/src/diff.hs --- a/src/diff.hs +++ b/src/diff.hs @@ -3,7 +3,8 @@ module Main (main) where import Control.Exception (bracket) -import Data.Aeson (Value, encode, decode) +import Codec (encode, decode, ForceFormat(..)) +import Data.Aeson (Value) import Data.Aeson.Diff (Config(Config), diff') import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL @@ -19,10 +20,12 @@ , optionOut :: File , optionFrom :: File , optionTo :: File + , optionYaml :: Bool } data Configuration = Configuration - { cfgTst :: Bool + { cfgOptions :: DiffOptions + , cfgTst :: Bool , cfgOut :: Handle , cfgFrom :: Handle , cfgTo :: Handle @@ -48,6 +51,10 @@ <*> argument fileP ( metavar "TO" ) + <*> switch + ( long "yaml" + <> help "Use yaml decoding and encoding." + ) where fileP = do s <- readerAsk @@ -55,11 +62,14 @@ "-" -> Nothing _ -> Just s -jsonFile :: Handle -> IO Value -jsonFile fp = do +jsonFile :: Handle -> ForceFormat -> File -> IO Value +jsonFile fp mformat mfilepath = do s <- BS.hGetContents fp - case decode (BSL.fromStrict s) of - Nothing -> error "Could not parse as JSON" + case decode mformat mfilepath (BSL.fromStrict s) of + Nothing -> + case mformat of + ForceYaml -> error "Could not parse as YAML" + AutodetectFormat -> error "Could not parse file. Make sure the file contents and the extension correspond: i.e. use '.json' for JSON files." Just v -> return v run :: DiffOptions -> IO () @@ -74,9 +84,10 @@ openw (Just p) = openFile p WriteMode load :: DiffOptions -> IO Configuration - load DiffOptions{..} = + load options@DiffOptions{..} = Configuration - <$> pure optionTst + <$> pure options + <*> pure optionTst <*> openw optionOut <*> openr optionFrom <*> openr optionTo @@ -89,11 +100,12 @@ process :: Configuration -> IO () process Configuration{..} = do - json_from <- jsonFile cfgFrom - json_to <- jsonFile cfgTo + let mformat = if optionYaml cfgOptions then ForceYaml else AutodetectFormat + json_from <- jsonFile cfgFrom mformat (optionFrom cfgOptions) + json_to <- jsonFile cfgTo mformat (optionTo cfgOptions) let c = Config cfgTst let p = diff' c json_from json_to - BS.hPutStrLn cfgOut $ BSL.toStrict (encode p) + BS.hPutStrLn cfgOut $ BSL.toStrict (encode mformat (optionOut cfgOptions) p) main :: IO () main = execParser opts >>= run diff --git a/src/patch.hs b/src/patch.hs --- a/src/patch.hs +++ b/src/patch.hs @@ -3,11 +3,12 @@ module Main (main) where import Control.Exception (bracket) -import Data.Aeson (Result(Error, Success), Value, decode, encode, fromJSON) +import Codec (decode, encode, ForceFormat(..)) +import Data.Aeson (Result(Error, Success), Value, fromJSON) import Data.Aeson.Diff (patch) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL -import Options.Applicative (fullDesc, info, execParser, helper, metavar, progDesc, argument, help, value, long, option, short) +import Options.Applicative (fullDesc, info, execParser, helper, metavar, progDesc, argument, help, value, long, option, short, switch) import Options.Applicative.Types (Parser, readerAsk) import System.IO (Handle, IOMode(ReadMode, WriteMode), hClose, openFile, stdin, stdout) @@ -18,10 +19,12 @@ { optionOut :: File -- ^ JSON destination , optionPatch :: File -- ^ Patch input , optionFrom :: File -- ^ JSON source + , optionYaml :: Bool } data Configuration = Configuration - { cfgOut :: Handle + { cfgOptions :: PatchOptions + , cfgOut :: Handle , cfgPatch :: Handle , cfgFrom :: Handle } @@ -43,6 +46,10 @@ ( metavar "FROM" <> help "JSON file to patch." ) + <*> switch + ( long "yaml" + <> help "Use yaml decoding and encoding." + ) where fileP = do s <- readerAsk @@ -50,10 +57,10 @@ "-" -> Nothing _ -> Just s -jsonRead :: Handle -> IO Value -jsonRead fp = do +jsonRead :: Handle -> ForceFormat -> File -> IO Value +jsonRead fp mformat mfilename = do s <- BS.hGetContents fp - case decode (BSL.fromStrict s) of + case decode mformat mfilename (BSL.fromStrict s) of Nothing -> error "Could not parse as JSON" Just v -> return v @@ -71,7 +78,8 @@ load :: PatchOptions -> IO Configuration load PatchOptions{..} = Configuration - <$> openw optionOut + <$> pure opt + <*> openw optionOut <*> openr optionPatch <*> openr optionFrom @@ -83,11 +91,12 @@ process :: Configuration -> IO () process Configuration{..} = do - json_patch <- jsonRead cfgPatch - json_from <- jsonRead cfgFrom + let mformat = if optionYaml cfgOptions then ForceYaml else AutodetectFormat + json_patch <- jsonRead cfgPatch mformat (optionPatch cfgOptions) + json_from <- jsonRead cfgFrom mformat (optionFrom cfgOptions) case fromJSON json_patch >>= flip patch json_from of Error e -> error e - Success d -> BS.hPutStrLn cfgOut $ BSL.toStrict (encode d) + Success d -> BS.hPutStrLn cfgOut $ BSL.toStrict (encode mformat (optionOut cfgOptions) d) main :: IO () main = execParser opts >>= run diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-14.7 +resolver: lts-19.1 extra-deps: [] flags: {} extra-package-dbs: []