gen/src/Gen/JSON.hs · gogol

on ce42607 help sign in

gogol/gen/src/Gen/JSON.hs

53 lines 1.7 kB history raw

1{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE OverloadedStrings #-}

4-- Module : Gen.JSON

6-- License : Mozilla Public License, v. 2.0.

7-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>

8-- Stability : provisional

9-- Portability : non-portable (GHC extensions)

11module Gen.JSON where

13import Control.Error

14import Control.Monad.Except

15import Data.Aeson hiding (decode)

16import Data.Aeson.Types

17import Data.Bifunctor

18import Data.ByteString (ByteString)

19import qualified Data.ByteString.Lazy as LBS

20import qualified Data.HashMap.Strict as Map

21import Data.List

22import qualified Data.Text.Lazy as LText

23import Gen.Formatting

24import Gen.IO

25import Gen.Types

26import qualified Text.EDE as EDE

28objectErr :: ToJSON a => String -> a -> Either Error Object

29objectErr n =

30 note (format ("Failed to extract JSON object from value " % string) n)

31 . EDE.fromValue

32 . toJSON

34load :: MonadIO m => Path -> ExceptT Error m Object

35load = readBSFile >=> hoistEither . decode

37decode :: ByteString -> Either Error Object

38decode = first LText.pack . eitherDecode' . LBS.fromStrict

40parse :: FromJSON a => Object -> Either Error a

41parse = first LText.pack . parseEither parseJSON . Object

43merge :: [Object] -> Object

44merge = foldl' go mempty

45 where

46 go :: Object -> Object -> Object

47 go = Map.unionWith value

49 value :: Value -> Value -> Value

50 value l r =

51 case (l, r) of

52 (Object x, Object y) -> Object (x `go` y)

53 (_, _) -> l