persistent-protobuf (empty) → 0.1.2

raw patch · 4 files changed

+121/−0 lines, 4 filesdep +basedep +bytestringdep +persistentsetup-changed

Dependencies added: base, bytestring, persistent, protocol-buffers, protocol-buffers-descriptor, template-haskell, text

Files

• Database/Persist/TH/ProtocolBuffers.hs +56/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• persistent-protobuf.cabal +33/−0

@@ -0,0 +1,56 @@+{-# LANGUAGE TemplateHaskell #-}+-- | 'derivePersistFieldPB' uses Template Haskell to produce+--   'Database.Persist.PersistField' instances for types with+--   'Text.ProtocolBuffers.Reflections.ReflectDescriptor' and+--   'Text.ProtocolBuffers.WireMessage.Wire' instances just as+--   'Database.Persist.TH.derivePersistField' produces+--   'Database.Persist.PersistField' instances for types with 'Read' and 'Show'+--   instances.+module Database.Persist.TH.ProtocolBuffers (+    derivePersistFieldPB+  ) where+import Database.Persist.Base+import Language.Haskell.TH.Syntax+import Text.ProtocolBuffers.WireMessage (messageGet, messagePut)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++strictify :: BSL.ByteString -> BS.ByteString+strictify x = BS.concat $ BSL.toChunks x++lazify :: BS.ByteString -> BSL.ByteString+lazify x = BSL.fromChunks [x]++-- | Derive 'Database.Persist.PersistField' instances for 'typName'. 'typName'+--   should be an instance of the+--   'Text.ProtocolBuffers.Reflections.ReflectDescriptor' and+--   'Text.ProtocolBuffers.WireMessage.Wire' classes.+derivePersistFieldPB :: String  -- ^ Name of the type to derive instances for.+                     -> Q [Dec]+derivePersistFieldPB typName = do+    ss <- [|SqlBlob|]+    tpv <- [|PersistByteString . strictify . messagePut|]+    fpv <- [|\dt v ->+                case fromPersistValue v of+                    Left e -> Left e+                    Right s' ->+                        case (messageGet . lazify) s' of+                            Left e ->+                              Left $ "Invalid " ++ dt ++ ": " ++ e+                            Right (_, x) | BSL.length x /= 0 ->+                              Left $ "Invalid " ++ dt ++ ": " ++ "excess input"+                            Right (msg, _) ->+                              Right msg|]+    return+        [ InstanceD [] (ConT ''PersistField `AppT` ConT (mkName typName))+            [ FunD (mkName "sqlType")+                [ Clause [WildP] (NormalB ss) []+                ]+            , FunD (mkName "toPersistValue")+                [ Clause [] (NormalB tpv) []+                ]+            , FunD (mkName "fromPersistValue")+                [ Clause [] (NormalB $ fpv `AppE` LitE (StringL typName)) []+                ]+            ]+        ]

@@ -0,0 +1,30 @@+Copyright (c) 2012, Akamai Techologies, Inc.++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.++    * Neither the name of Akamai Technologies nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@+Name:                persistent-protobuf+Version:             0.1.2+Synopsis:            Template-Haskell helpers for integrating protobufs with persistent.+Description:         Template-Haskell helpers for integrating protobufs with persistent.+Homepage:            https://github.com/mstone/persistent-protobuf+License:             BSD3+License-file:        LICENSE+Author:              Michael Stone+Maintainer:          mistone@akamai.com+Copyright:           Copyright 2012 Akamai Technologies, Inc.+Category:            Database+Build-type:          Simple+Cabal-version:       >=1.6++source-repository head+  type:     git+  location: git://github.com/mstone/persistent-protobuf.git++source-repository this+  type:     git+  location: git://github.com/mstone/persistent-protobuf.git+  tag:      v0.1.2++Library+  Exposed-modules:   Database.Persist.TH.ProtocolBuffers+  Build-Depends:     base == 4.*,+                     bytestring -any,+                     persistent -any,+                     protocol-buffers -any,+                     protocol-buffers-descriptor -any,+                     template-haskell -any,+                     text -any+  GHC-Options:       -Wall -funbox-strict-fields