persistable-types-HDBC-pg 0.0.1.5 → 0.0.2.0

raw patch · 4 files changed

+129/−9 lines, 4 filesdep +dlistdep +persistable-types-HDBC-pgdep +relational-queryPVP ok

version bump matches the API change (PVP)

Dependencies added: dlist, persistable-types-HDBC-pg, relational-query

API changes (from Hackage documentation)

Files

• persistable-types-HDBC-pg.cabal +21/−3
• src/Database/HDBC/PostgreSQL/Instances.hs +26/−1
• src/Database/HDBC/PostgreSQL/Persistable.hs +14/−5
• test/runTest.hs +68/−0

@@ -1,5 +1,5 @@ name:                persistable-types-HDBC-pg-version:             0.0.1.5+version:             0.0.2.0 synopsis:            HDBC and Relational-Record instances of PostgreSQL extended types description:         This package contains HDBC Convertible instances and                      Relational-Record persistable instances of PostgreSQL extended types@@ -9,11 +9,12 @@ license-file:        LICENSE author:              Kei Hibino maintainer:          ex8k.hibino@gmail.com-copyright:           Copyright (c) 2015-2017 Kei Hibino+copyright:           Copyright (c) 2015-2018 Kei Hibino category:            Database build-type:          Simple cabal-version:       >=1.10-tested-with:           GHC == 8.2.1+tested-with:           GHC == 8.4.1, GHC == 8.4.2+                     , GHC == 8.2.1, GHC == 8.2.2                      , GHC == 8.0.1, GHC == 8.0.2                      , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3                      , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4@@ -33,10 +34,27 @@   other-extensions:    MultiParamTypeClasses   build-depends:       base <5                      , bytestring+                     , dlist                      , text-postgresql                      , convertible                      , HDBC                      , persistable-record >= 0.4+                     , relational-query                      , relational-query-HDBC   hs-source-dirs:      src   default-language:    Haskell2010++test-suite test+  build-depends:         base <5+                       , relational-query+                       , relational-query-HDBC+                       , text-postgresql+                       , persistable-types-HDBC-pg++  type:                exitcode-stdio-1.0+  main-is:             runTest.hs++  hs-source-dirs:      test+  ghc-options:         -Wall++  default-language:     Haskell2010

@@ -1,14 +1,30 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} +-- |+-- Module      : Database.HDBC.PostgreSQL.Instances+-- Copyright   : 2015-2018 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines HDBC instances and SQL-literal instances for+-- PostgreSQL types module Database.HDBC.PostgreSQL.Instances () where  import Control.Applicative ((<$>), pure, (<*))+import Data.String (IsString, fromString)+import Data.Monoid ((<>))+import Data.DList () import Data.ByteString.Char8 (unpack) import Data.Convertible (Convertible (..), ConvertResult, ConvertError (..))-import Data.PostgreSQL.NetworkAddress (NetAddress (..), Inet (..), Cidr (..))+import Data.PostgreSQL.NetworkAddress (NetAddress, Inet (..), Cidr (..)) import Database.HDBC (SqlValue (..)) import Database.HDBC.Record.Persistable ()+import Database.Relational.Query (ShowConstantTermsSQL (..)) import Database.PostgreSQL.Parser (evalParser) import qualified Database.PostgreSQL.Parser as Parser import Database.PostgreSQL.Printer (execPrinter)@@ -54,3 +70,12 @@  instance Convertible Cidr SqlValue where   safeConvert (Cidr n) = fromNetAddress n++qstringNetAddr :: IsString s => NetAddress -> s+qstringNetAddr = fromString . ("'" ++) . (++ "'") . execPrinter Printer.netAddress++instance ShowConstantTermsSQL Inet where+  showConstantTermsSQL' (Inet na) = pure $ "INET" <> qstringNetAddr na++instance ShowConstantTermsSQL Cidr where+  showConstantTermsSQL' (Cidr na) = pure $ "CIDR" <> qstringNetAddr na

@@ -1,24 +1,33 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-} +-- |+-- Module      : Database.HDBC.PostgreSQL.Persistable+-- Copyright   : 2015-2018 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines Persistable instances for PostgreSQL types module Database.HDBC.PostgreSQL.Persistable () where  import Data.Convertible (convert) 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 (..), valueRecordFromSql) import Database.Record.ToSql (ToSql (..), valueRecordToSql)+import Database.Record.TH (deriveNotNullType)  import Database.HDBC.PostgreSQL.Instances ()  -instance PersistableWidth Inet where-  persistableWidth = unsafeValueWidth+$(deriveNotNullType [t| Inet |]) -instance PersistableWidth Cidr where-  persistableWidth = unsafeValueWidth+$(deriveNotNullType [t| Cidr |])  instance FromSql SqlValue Inet where   recordFromSql = valueRecordFromSql convert

@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}++import GHC.Generics (Generic)+import Control.Applicative ((<$>), (*>))+import Control.Monad (unless)+import Database.HDBC.Query.TH (makeRelationalRecord)+import Data.PostgreSQL.NetworkAddress+  (Inet (..), Cidr (..), NetAddress (..),+   V4HostAddress (..), V6HostAddress (..))+import Database.Relational.Query (Relation, relation, value)++import Database.HDBC.PostgreSQL.Persistable ()+++data Foo =+  Foo+  { s0 :: String+  , i1 :: Maybe Inet+  , c2 :: Maybe Cidr+  } deriving Generic++-- compile time check+$(makeRelationalRecord ''Foo)++-- 192.168.0.1/24+inet4 :: Relation () Inet+inet4 =+  relation . return . value . Inet $+  NetAddress4 (V4HostAddress 192 168 0 1) 24++-- 224.0.0.0/4+cidr4 :: Relation () Cidr+cidr4 =+  relation . return . value . Cidr $+  NetAddress4 (V4HostAddress 224 0 0 0) 4++-- fd00::1/8+inet6 :: Relation () Inet+inet6 =+  relation . return . value . Inet $+  NetAddress6 (V6HostAddress 0xfd00 0 0 0 0 0 0 1) 8++-- ff00::/8+cidr6 :: Relation () Cidr+cidr6 =+  relation . return . value . Cidr $+  NetAddress6 (V6HostAddress 0xff00 0 0 0 0 0 0 0) 8++testSet :: [(String, String, [String])]+testSet =+  [("inet - v4", show inet4, ["SELECT","ALL","INET","'192.168.0.1/24'","AS","f0"]),+   ("cidr - v4", show cidr4, ["SELECT","ALL","CIDR","'224.0.0.0/4'","AS","f0"]),+   ("inet - v6", show inet6, ["SELECT","ALL","INET","'fd00:0:0:0:0:0:0:1/8'","AS","f0"]),+   ("cidr - v6", show cidr6, ["SELECT","ALL","CIDR","'ff00:0:0:0:0:0:0:0/8'","AS","f0"])]++doTest :: (String, String, [String]) -> IO Bool+doTest (tag, q, a)+  | words q == a  =  putStrLn ("success: " ++ tag) *> return True+  | otherwise     =  putStrLn ("failed: " ++ tag) *> return False++main :: IO ()+main = do+  ok <- and <$> mapM doTest testSet+  unless ok $ fail "some tests are failed!"