persistable-types-HDBC-pg (empty) → 0.0.1.0

raw patch · 5 files changed

+149/−0 lines, 5 filesdep +HDBCdep +basedep +bytestringsetup-changed

Dependencies added: HDBC, base, bytestring, convertible, persistable-record, relational-query-HDBC, text-postgresql

Files

LICENSE +30/−0
Setup.hs +2/−0
persistable-types-HDBC-pg.cabal +29/−0
src/Database/HDBC/PostgreSQL/Instances.hs +56/−0
src/Database/HDBC/PostgreSQL/Persistable.hs +32/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, Kei Hibino++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 Kei Hibino 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.

+ Setup.hs view

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

+ persistable-types-HDBC-pg.cabal view

@@ -0,0 +1,29 @@+name:                persistable-types-HDBC-pg+version:             0.0.1.0+synopsis:            HDBC Convertible instances and HRR persistable instances of PostgreSQL extended types+description:+homepage:            http://khibino.github.io/haskell-relational-record/+license:             BSD3+license-file:        LICENSE+author:              Kei Hibino+maintainer:          ex8k.hibino@gmail.com+copyright:           Copyright (c) 2015 Kei Hibino+category:            Database+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:+                       Database.HDBC.PostgreSQL.Instances+                       Database.HDBC.PostgreSQL.Persistable++  other-extensions:    MultiParamTypeClasses+  build-depends:       base <5+                     , bytestring+                     , text-postgresql+                     , convertible+                     , HDBC+                     , persistable-record+                     , relational-query-HDBC+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Database/HDBC/PostgreSQL/Instances.hs view

@@ -0,0 +1,56 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Database.HDBC.PostgreSQL.Instances () where++import Control.Applicative ((<$>), pure, (<*))+import Data.ByteString.Char8 (unpack)+import Data.Convertible (Convertible (..), ConvertResult, ConvertError (..))+import Data.PostgreSQL.NetworkAddress (NetAddress (..), Inet (..), Cidr (..))+import Database.HDBC (SqlValue (..))+import Database.HDBC.Record.Persistable ()+import Database.PostgreSQL.Parser (evalParser)+import qualified Database.PostgreSQL.Parser as Parser+import Database.PostgreSQL.Printer (execPrinter)+import qualified Database.PostgreSQL.Printer as Printer+++note :: a -> Maybe b -> Either a b+note e = maybe (Left e) Right++mapConvert :: Show a => String -> String -> a -> Either String b -> ConvertResult b+mapConvert srcT destT sv = either (Left . mke) Right  where+  mke em =+    ConvertError+    { convSourceValue   =  show sv+    , convSourceType    =  srcT+    , convDestType      =  destT+    , convErrorMessage  =  em+    }++takeAddressString :: SqlValue -> Maybe String+takeAddressString = d  where+  d (SqlString s)      =  Just s+  d (SqlByteString s)  =  Just $ unpack s+  d  _                 =  Nothing++toNetAddress :: SqlValue -> ConvertResult NetAddress+toNetAddress qv = mapConvert "SqlValue" "NetAddress" qv $ do+  s  <-  note "Fail to take address string from the column value."+         $ takeAddressString qv+  evalParser (Parser.netAddress <* Parser.eof) s++instance Convertible SqlValue Inet where+  safeConvert = (Inet <$>) . toNetAddress++instance Convertible SqlValue Cidr where+  safeConvert = (Cidr <$>) . toNetAddress++fromNetAddress :: NetAddress -> ConvertResult SqlValue+fromNetAddress = pure . SqlString . execPrinter Printer.netAddress++instance Convertible Inet SqlValue where+  safeConvert (Inet n) = fromNetAddress n++instance Convertible Cidr SqlValue where+  safeConvert (Cidr n) = fromNetAddress n

+ src/Database/HDBC/PostgreSQL/Persistable.hs view

@@ -0,0 +1,32 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Database.HDBC.PostgreSQL.Persistable () where++import Data.PostgreSQL.NetworkAddress (Inet, Cidr)+import Database.HDBC (SqlValue)+import Database.HDBC.Record.Persistable ()+import Database.Record.Persistable (PersistableWidth (..), unsafeValueWidth)+import Database.Record.FromSql (FromSql (..), valueFromSql)+import Database.Record.ToSql (ToSql (..), valueToSql)++import Database.HDBC.PostgreSQL.Instances ()+++instance PersistableWidth Inet where+  persistableWidth = unsafeValueWidth++instance PersistableWidth Cidr where+  persistableWidth = unsafeValueWidth++instance FromSql SqlValue Inet where+  recordFromSql = valueFromSql++instance FromSql SqlValue Cidr where+  recordFromSql = valueFromSql++instance ToSql SqlValue Inet where+  recordToSql = valueToSql++instance ToSql SqlValue Cidr where+  recordToSql = valueToSql