module Data.Object.Json
(
JsonDoc (..)
, JsonScalar (..)
, JsonObject
, readJsonDoc
, writeJsonDoc
, JsonDecodeError (..)
, decode
, encode
, 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 Text.JSONb.Simple as J
import qualified Text.JSONb.Decode as Decode
import qualified Text.JSONb.Encode as Encode
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
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])
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
newtype JsonDecodeError = JsonDecodeError String
deriving (Show, Typeable)
instance Exception JsonDecodeError
decode :: MonadFailure JsonDecodeError m
=> BL.ByteString
-> m JsonObject
decode = either (failure . JsonDecodeError . fst)
(return . toJsonObject)
. Decode.decode
encode :: JsonObject
-> BL.ByteString
encode = Encode.encode Encode.Compact
. fromSuccess
. fromJsonObject
toJsonObject :: ConvertSuccess a JsonObject => a -> JsonObject
toJsonObject = cs
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