diff --git a/Data/Object/Json.hs b/Data/Object/Json.hs new file mode 100644 --- /dev/null +++ b/Data/Object/Json.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell #-} +--------------------------------------------------------- +-- +-- Module : Data.Object.Json +-- Copyright : Michael Snoyman +-- License : BSD3 +-- +-- Maintainer : Michael Snoyman +-- Stability : Stable +-- Portability : portable +--------------------------------------------------------- + +-- | A simple wrapper around the json-b library which presents values inside +-- 'Object's. +module Data.Object.Json + ( -- * Types + JsonDoc (..) + , JsonScalar (..) + , JsonObject + -- * IO + , readJsonDoc + , writeJsonDoc + -- * Serialization + , JsonDecodeError (..) + , decode + , encode + -- * Specialization + , toJsonObject + , fromJsonObject + ) where + +import Data.Object.Text +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Trie +import Control.Arrow +import Control.Applicative ((<$>)) +import Data.Generics +import Control.Exception +import Data.Attempt +import Data.Convertible.Text + +import Text.JSONb.Simple as J +import qualified Text.JSONb.Decode as Decode +import qualified Text.JSONb.Encode as Encode + +-- | A fully formed JSON document. +newtype JsonDoc = JsonDoc { unJsonDoc :: BL.ByteString } + deriving (Show, Eq) + +readJsonDoc :: FilePath -> IO JsonDoc +readJsonDoc = fmap JsonDoc . BL.readFile + +writeJsonDoc :: FilePath -> JsonDoc -> IO () +writeJsonDoc fp = BL.writeFile fp . unJsonDoc + +-- | Matches the scalar data types used in json-b so we can have proper mapping +-- between the two libraries. +data JsonScalar = + JsonString BS.ByteString + | JsonNumber Rational + | JsonBoolean Bool + | JsonNull + +instance ConvertSuccess JsonScalar Text where + convertSuccess (JsonString b) = convertSuccess b + convertSuccess (JsonNumber r) = convertSuccess r + convertSuccess (JsonBoolean b) = convertSuccess b + convertSuccess JsonNull = convertSuccess "" +instance ConvertSuccess Text JsonScalar where + convertSuccess = JsonString . convertSuccess + +instance ConvertSuccess JsonScalar String where + convertSuccess = cs . (cs :: JsonScalar -> Text) +instance ConvertSuccess String JsonScalar where + convertSuccess = JsonString . cs + +instance ConvertSuccess JsonScalar BS.ByteString where + convertSuccess = cs . (cs :: JsonScalar -> Text) +instance ConvertSuccess BS.ByteString JsonScalar where + convertSuccess = JsonString . cs + +$(let types = [''String, ''BS.ByteString, ''Text] + in deriveAttempts $ + [(k, ''JsonScalar) | k <- types] ++ + [(''JsonScalar, v) | v <- types]) + +$(deriveSuccessConvs ''BS.ByteString ''JsonScalar + [''String, ''BS.ByteString, ''Text] + [''String, ''BS.ByteString, ''Text, ''JsonScalar]) + +-- | Meant to match closely with the 'JSON' data type. Therefore, uses strict +-- byte strings for keys and the 'JsonScalar' type for scalars. +type JsonObject = Object BS.ByteString JsonScalar + +instance ConvertSuccess JSON JsonObject where + convertSuccess (J.Object trie) = + Mapping . map (second cs) $ Data.Trie.toList trie + convertSuccess (J.Array a) = Sequence $ map cs $ a + convertSuccess (J.String bs) = Scalar $ JsonString bs + convertSuccess (J.Number r) = Scalar $ JsonNumber r + convertSuccess (J.Boolean b) = Scalar $ JsonBoolean b + convertSuccess J.Null = Scalar JsonNull +instance ConvertAttempt JsonObject JSON where + convertAttempt (Scalar (JsonString bs)) = return $ J.String bs + convertAttempt (Scalar (JsonNumber r)) = return $ J.Number r + convertAttempt (Scalar (JsonBoolean b)) = return $ J.Boolean b + convertAttempt (Scalar JsonNull) = return J.Null + convertAttempt (Sequence s) = J.Array <$> mapM ca s + convertAttempt (Mapping m) = + J.Object . Data.Trie.fromList <$> mapM + (runKleisli $ second $ Kleisli ca) m + +-- | Error type for JSON decoding errors. +newtype JsonDecodeError = JsonDecodeError String + deriving (Show, Typeable) +instance Exception JsonDecodeError + +-- | Decode a lazy bytestring into a 'JsonObject'. +decode :: MonadFailure JsonDecodeError m + => BL.ByteString + -> m JsonObject +decode = either (failure . JsonDecodeError . fst) + (return . toJsonObject) + . Decode.decode + +-- | Encode a 'JsonObject' into a lazy bytestring. +encode :: JsonObject + -> BL.ByteString +encode = Encode.encode Encode.Compact + . fromSuccess + . fromJsonObject + +-- | 'convertSuccess' specialized for 'JsonObject's +toJsonObject :: ConvertSuccess a JsonObject => a -> JsonObject +toJsonObject = cs + +-- | 'convertAttempt' specialized for 'JsonObject's +fromJsonObject :: ConvertAttempt JsonObject a + => JsonObject + -> Attempt a +fromJsonObject = ca + +instance ConvertSuccess JsonObject JsonDoc where + convertSuccess = JsonDoc . encode +instance ConvertAttempt JsonDoc JsonObject where + convertAttempt = decode . unJsonDoc diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2008, Michael Snoyman. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO +EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,11 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple +> import System.Cmd (system) + +> main :: IO () +> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' }) + +> runTests' :: a -> b -> c -> d -> IO () +> runTests' _ _ _ _ = system "runhaskell Test.hs" >> return () diff --git a/data-object-json.cabal b/data-object-json.cabal new file mode 100644 --- /dev/null +++ b/data-object-json.cabal @@ -0,0 +1,24 @@ +name: data-object-json +version: 0.0.0 +license: BSD3 +license-file: LICENSE +author: Michael Snoyman +maintainer: Michael Snoyman +synopsis: Serialize JSON data to/from Haskell using the data-object library. +category: Text +stability: Stable +cabal-version: >= 1.2 +build-type: Simple +homepage: http://github.com/snoyberg/data-object-json/tree/master + +library + build-depends: base >= 4 && < 5, + json-b >= 0.0.4 && < 0.1, + bytestring-trie >= 0.1.4 && < 0.2, + bytestring >= 0.9.1.4 && < 0.10, + data-object >= 0.2.0 && < 0.3, + attempt >= 0.2.0 && < 0.3, + convertible-text >= 0.2.0 && < 0.3, + syb + exposed-modules: Data.Object.Json + ghc-options: -Wall