JSON helper functions. BSD Licensed.

JSON.hs

module JSON (module J, writeJson, readJson, diffJsonFiles) where

import Import
import Data.Aeson as J
import Data.HashMap.Strict as J (lookup)

import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy.UTF8 (toString)
import Data.Set (difference, fromList, toList)
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V

instance Ord Value where
  compare (Number x) (Number y) = compare x y
  compare (Number _) y = compare (String "") y
  compare (String x) (String y) = compare x y
  compare (String _) y = compare (Array V.empty) y
  compare (Array xs) (Array ys) = compare xs ys
  compare (Array _) y = compare (Object HM.empty) y
  compare (Object x) (Object y) = compare x y
  compare (Object _) y = compare (Bool False) y
  compare (Bool x) (Bool y) = compare x y
  compare (Bool _) y = compare Null y
  compare Null y = if y == Null
                   then EQ
                   else LT

instance Ord Object where
  compare x y = let c = compare (HM.keys x) (HM.keys y)
           in if c == EQ
             then compare (HM.elems x) (HM.elems y)
             else c

writeJson :: forall (m :: * -> *) a.
                   (MonadIO m, ToJSON a) =>
                   FilePath -> a -> m ()
writeJson file = liftIO . writeFile file . toString . encode

readJson :: forall (m :: * -> *) a.
                  (MonadIO m, FromJSON a) =>
                  FilePath -> m a
readJson = liftIO . fmap (fromJust . decode) . B.readFile

diffJsonFiles :: forall (m :: * -> *) a.
                       (Ord a, MonadIO m, FromJSON a) =>
                       FilePath -> FilePath -> m [a]
diffJsonFiles f1 f2 = liftIO $ do
  j1 <- readJson f1
  j2 <- readJson f2
  let s1 = fromList j1
      s2 = fromList j2
  return $ toList $ difference s1 s2