abeson (empty) → 0.1.0
raw patch · 4 files changed
+179/−0 lines, 4 filesdep +aesondep +basedep +base64-bytestringsetup-changed
Dependencies added: aeson, base, base64-bytestring, bson, bytestring, data-default-class, scientific, text, time, unordered-containers, uuid, vector
Files
- Data/Abeson.hs +119/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- abeson.cabal +38/−0
+ Data/Abeson.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+module Data.Abeson+ ( AbesonConfig(..)+ , toAeson, toAesonValue+ , toBson, toBsonValue+ -- * reexport+ , def+ ) where++import Data.Default.Class+import qualified Data.Aeson as A+import qualified Data.Bson as B++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Base64 as Base64++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy.Builder as LB++import qualified Data.HashMap.Strict as H+import qualified Data.Vector as V+import qualified Data.UUID as UUID+import Data.Monoid+import Data.Scientific+import Data.Int+import Data.Bits+import Data.Time.Clock.POSIX++data AbesonConfig = AbesonConfig+ { binaryEncoding :: AbesonConfig -> S.ByteString -> A.Value+ , functionEncoding :: AbesonConfig -> S.ByteString -> A.Value+ , userDefEncoding :: AbesonConfig -> S.ByteString -> A.Value+ , objectIdEncoding :: AbesonConfig -> B.ObjectId -> A.Value+ , regexEncoding :: AbesonConfig -> B.Regex -> A.Value+ , javascriptEncoding :: AbesonConfig -> B.Javascript -> A.Value+ , stampEncoding :: AbesonConfig -> Int64 -> A.Value+ , minMaxKeyEncoding :: AbesonConfig -> B.MinMaxKey -> A.Value+ }++-- | binary, function, userDef -> base64 encoding+--+-- objectid -> show+--+-- regex -> \/pat\/mod+--+-- javascript -> {environment: env, code: code}+--+-- stamp -> {t: time_t, i: ordinal}+--+-- minkey -> -1, maxkey -> 1+instance Default AbesonConfig where+ def = AbesonConfig+ { binaryEncoding = const $ A.String . T.decodeUtf8 . Base64.encode+ , functionEncoding = const $ A.String . T.decodeUtf8 . Base64.encode+ , userDefEncoding = const $ A.String . T.decodeUtf8 . Base64.encode+ , objectIdEncoding = const $ A.String . T.pack . show+ , regexEncoding = \_ (B.Regex p m) ->+ A.String . TL.toStrict . LB.toLazyText $+ LB.singleton '/' <> LB.fromText p <> LB.singleton '/' <> LB.fromText m+ , javascriptEncoding = \c (B.Javascript env bdy) ->+ A.object [ "environment" A..= A.Object (toAeson c env)+ , "code" A..= A.String bdy+ ]+ , stampEncoding = const defaultStampEncode+ , minMaxKeyEncoding = const $ \case+ B.MinKey -> A.toJSON (-1 :: Int)+ B.MaxKey -> A.toJSON ( 1 :: Int)+ }++defaultStampEncode :: Int64 -> A.Value+defaultStampEncode i = A.object+ [ "t" A..= posixSecondsToUTCTime (fromIntegral $ shiftR i 32)+ , "i" A..= (i .&. 0xffff)+ ]++toAeson :: AbesonConfig -> B.Document -> A.Object+toAeson c d = H.fromList $+ map (\(label B.:= value) -> (label, toAesonValue c value)) d++toAesonValue :: AbesonConfig -> B.Value -> A.Value+toAesonValue _ (B.Float b) = A.Number $ fromFloatDigits b+toAesonValue _ (B.String b) = A.String b+toAesonValue c (B.Doc b) = A.Object $ toAeson c b+toAesonValue c (B.Array b) = A.Array . V.fromList $ map (toAesonValue c) b+toAesonValue c (B.Bin (B.Binary b)) = binaryEncoding c c b+toAesonValue c (B.Fun (B.Function b)) = functionEncoding c c b+toAesonValue _ (B.Uuid (B.UUID b)) = case UUID.fromByteString (L.fromStrict b) of+ Nothing -> error ""+ Just ui -> (A.String . T.decodeUtf8 . UUID.toASCIIBytes) ui+toAesonValue _ (B.Md5 (B.MD5 b)) = A.String $ T.decodeUtf8 b+toAesonValue c (B.UserDef (B.UserDefined b)) = userDefEncoding c c b+toAesonValue c (B.ObjId b) = objectIdEncoding c c b+toAesonValue _ (B.Bool b) = A.Bool b+toAesonValue _ (B.UTC b) = A.toJSON b+toAesonValue _ B.Null = A.Null+toAesonValue c (B.RegEx b) = regexEncoding c c b+toAesonValue c (B.JavaScr b) = javascriptEncoding c c b+toAesonValue _ (B.Sym (B.Symbol b)) = A.String b+toAesonValue _ (B.Int32 b) = A.toJSON b+toAesonValue _ (B.Int64 b) = A.toJSON b+toAesonValue c (B.Stamp (B.MongoStamp b)) = stampEncoding c c b+toAesonValue c (B.MinMax b) = minMaxKeyEncoding c c b++toBson :: A.Object -> B.Document+toBson = map (\(k,v) -> k B.:= toBsonValue v) . H.toList++toBsonValue :: A.Value -> B.Value+toBsonValue (A.Object a) = B.Doc $ toBson a+toBsonValue (A.Array a) = B.Array $ map toBsonValue (V.toList a)+toBsonValue (A.String a) = B.String a+toBsonValue (A.Number a) = case floatingOrInteger a of+ Left f -> B.Float f+ Right i -> B.Int64 i+toBsonValue (A.Bool a) = B.Bool a+toBsonValue A.Null = B.Null
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Hirotomo Moriwaki++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ abeson.cabal view
@@ -0,0 +1,38 @@+name: abeson+version: 0.1.0+synopsis: interconversion between aeson and bson.+-- description:+license: MIT+license-file: LICENSE+author: HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer: HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage: https://github.com/philopon/abson+Bug-reports: https://github.com/philopon/abson/issues+copyright: (c) 2014 Hirotomo Moriwaki+category: Data+build-type: Simple+stability: experimental+-- extra-source-files:+cabal-version: >=1.10++library+ exposed-modules: Data.Abeson+ -- other-modules: + build-depends: base >=4.6 && <4.8+ , data-default-class >=0.0 && <0.1+ , aeson >=0.7 && <0.9+ , bson >=0.3 && <0.4+ , bytestring >=0.10 && <0.11+ , base64-bytestring >=1.0 && <1.1+ , text >=1.1 && <1.3+ , unordered-containers >=0.2 && <0.3+ , vector >=0.10 && <0.11+ , uuid >=1.3 && <1.4+ , scientific >=0.3 && <0.4+ , time >=1.4 && <1.5+ ghc-options: -O2 -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: git://github.com/philopon/abson.git