ihp-postgresql-simple-extra (empty) → 1.3.0
raw patch · 16 files changed
+739/−0 lines, 16 filesdep +aesondep +attoparsecdep +base
Dependencies added: aeson, attoparsec, base, basic-prelude, bytestring, hspec, hspec-discover, ihp-postgresql-simple-extra, ip, postgresql-simple, text, time, time-compat
Files
- IHP/Postgres/Inet.hs +40/−0
- IHP/Postgres/Interval.hs +42/−0
- IHP/Postgres/Point.hs +71/−0
- IHP/Postgres/Polygon.hs +60/−0
- IHP/Postgres/TSVector.hs +83/−0
- IHP/Postgres/TimeParser.hs +126/−0
- IHP/Postgres/TypeInfo.hs +22/−0
- LICENSE +21/−0
- README.md +9/−0
- Test/Postgres/Interval.hs +21/−0
- Test/Postgres/Point.hs +26/−0
- Test/Postgres/Polygon.hs +50/−0
- Test/Postgres/Support.hs +15/−0
- Test/Postgres/TSVector.hs +44/−0
- Test/Spec.hs +16/−0
- ihp-postgresql-simple-extra.cabal +93/−0
+ IHP/Postgres/Inet.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+{-|+Module: IHP.Postgres.Inet+Description: Adds support for storing IP addresses in INET fields. CIDR Notation is not supported at the moment.+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Postgres.Inet where++import BasicPrelude++import Database.PostgreSQL.Simple.ToField+import Database.PostgreSQL.Simple.FromField+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI+import Data.Attoparsec.ByteString.Char8 as Attoparsec++-- We use the @ip@ package for representing IP addresses+import qualified Net.IP as IP+import Net.IP (IP)+import qualified Data.Text.Encoding as Text++instance FromField IP where+ fromField f v =+ if typeOid f /= $(inlineTypoid TI.inet)+ then returnError Incompatible f ""+ else case v of+ Nothing -> returnError UnexpectedNull f ""+ Just bs ->+ case parseOnly parser bs of+ Left err -> returnError ConversionFailed f err+ Right val -> pure val+ where+ parser = do+ ip <- Attoparsec.takeWhile (\char -> char /= ' ')+ case IP.decode (Text.decodeUtf8 ip) of+ Just ip -> pure ip+ Nothing -> fail "Invalid IP"++instance ToField IP where+ toField ip = toField (IP.encode ip)
+ IHP/Postgres/Interval.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell #-}+{-|+Module: IHP.Postgres.Interval+Description: Adds support for the Postgres Interval type+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Postgres.Interval where++import BasicPrelude++import Database.PostgreSQL.Simple.ToField+import Database.PostgreSQL.Simple.FromField+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI+import Data.Attoparsec.ByteString.Char8 as Attoparsec+import Data.Aeson++import IHP.Postgres.TimeParser (PGInterval(..))+import qualified Data.Text.Encoding as Text++instance FromField PGInterval where+ fromField f v =+ if typeOid f /= $(inlineTypoid TI.interval)+ then returnError Incompatible f ""+ else case v of+ Nothing -> returnError UnexpectedNull f ""+ Just bs -> case parseOnly pPGInterval bs of+ Left err -> returnError ConversionFailed f err+ Right val -> pure val++pPGInterval = do+ bs <- takeByteString+ pure (PGInterval bs)++instance ToField PGInterval where+ toField (PGInterval interval) = toField (interval)++instance FromJSON PGInterval where+ parseJSON = withText "PGInterval" $ \text -> pure (PGInterval (encodeUtf8 text))++instance ToJSON PGInterval where+ toJSON (PGInterval pgInterval) = String (Text.decodeUtf8 pgInterval)
+ IHP/Postgres/Point.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TemplateHaskell #-}+{-|+Module: IHP.Postgres.Point+Description: Adds support for the Postgres Point type+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Postgres.Point where++import GHC.Float+import BasicPrelude++import Database.PostgreSQL.Simple.ToField+import Database.PostgreSQL.Simple.FromField+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI+import Data.ByteString.Builder (byteString, char8)+import Data.Attoparsec.ByteString.Char8 hiding (Result, char8, Parser(..))+import Data.Attoparsec.Internal.Types (Parser)+import Data.Aeson++-- | Represents a Postgres Point+--+-- See https://www.postgresql.org/docs/9.5/datatype-geometric.html+data Point = Point { x :: Double, y :: Double }+ deriving (Eq, Show, Ord)++instance FromField Point where+ fromField f v =+ if typeOid f /= $(inlineTypoid TI.point)+ then returnError Incompatible f ""+ else case v of+ Nothing -> returnError UnexpectedNull f ""+ Just bs ->+ case parseOnly parsePoint bs of+ Left err -> returnError ConversionFailed f err+ Right val -> pure val++parsePoint :: Parser ByteString Point+parsePoint = do+ string "("+ x <- doubleOrNaN+ string ","+ y <- doubleOrNaN+ string ")"+ pure $ Point { x, y }+ where+ -- Postgres supports storing NaN inside a point, so we have to deal+ -- with that here as well+ doubleOrNaN = double <|> (string "NaN" >> (pure $ 0 / 0))+++instance ToField Point where+ toField = serializePoint++serializePoint :: Point -> Action+serializePoint Point { x, y } = Many+ [ Plain (byteString "point(")+ , toField x+ , Plain (char8 ',')+ , toField y+ , Plain (char8 ')')+ ]+++instance FromJSON Point where+ parseJSON = withObject "Point" $ \v -> Point+ <$> v .: "x"+ <*> v .: "y"++instance ToJSON Point where+ toJSON Point { x, y } = object [ "x" .= x, "y" .= y ]
+ IHP/Postgres/Polygon.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE TemplateHaskell #-}+{-|+Module: IHP.Postgres.Polygon+Description: Adds support for the Postgres Polygon type+Copyright: (c) digitally induced GmbH, 2022+-}+module IHP.Postgres.Polygon where++import BasicPrelude++import Database.PostgreSQL.Simple.ToField+import Database.PostgreSQL.Simple.FromField+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI+import Data.ByteString.Builder (byteString, char8)+import Data.Attoparsec.ByteString.Char8 hiding (Result, char8, Parser(..))+import Data.Attoparsec.Internal.Types (Parser)+import IHP.Postgres.Point++-- | Represents a Postgres Polygon+--+-- See https://www.postgresql.org/docs/9.5/datatype-geometric.html+data Polygon = Polygon { points :: [Point] }+ deriving (Eq, Show, Ord)++instance FromField Polygon where+ fromField f v =+ if typeOid f /= $(inlineTypoid TI.polygon)+ then returnError Incompatible f ""+ else case v of+ Nothing -> returnError UnexpectedNull f ""+ Just bs ->+ case parseOnly parsePolygon bs of+ Left err -> returnError ConversionFailed f err+ Right val -> pure val++parsePolygon :: Parser ByteString Polygon+parsePolygon = do+ string "("+ points <- parsePoint `sepBy` (char ',')+ string ")"+ pure $ Polygon points++instance ToField Polygon where+ toField = serializePolygon++serializePolygon :: Polygon -> Action+serializePolygon Polygon { points } = Many $+ (Plain (byteString "polygon'")):+ ( (intersperse (Plain $ char8 ',') $ map serializePoint' points)+ ++ [ Plain (char8 '\'') ])+ where+ serializePoint' :: Point -> Action+ serializePoint' Point { x, y } = Many $+ [ Plain (char8 '(')+ , toField x+ , Plain (char8 ',')+ , toField y+ , Plain (char8 ')')+ ]
+ IHP/Postgres/TSVector.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE TemplateHaskell #-}+{-|+Module: IHP.Postgres.TSVector+Description: Adds support for the Postgres tsvector type+Copyright: (c) digitally induced GmbH, 2021+-}+module IHP.Postgres.TSVector where++import BasicPrelude+import IHP.Postgres.TypeInfo+import Database.PostgreSQL.Simple.ToField+import Database.PostgreSQL.Simple.FromField+import Database.PostgreSQL.Simple.TypeInfo.Macro+import Data.Attoparsec.ByteString.Char8 as Attoparsec hiding (Parser(..))+import Data.Attoparsec.Internal.Types (Parser)+import Data.ByteString.Builder (byteString, charUtf8)+import qualified Data.Text.Encoding as Text++-- | Represents a Postgres tsvector+--+-- See https://www.postgresql.org/docs/current/datatype-textsearch.html+data TSVector+ = TSVector [Lexeme]+ deriving (Eq, Show, Ord)++data Lexeme+ = Lexeme { token :: Text, ranking :: [LexemeRanking] }+ deriving (Eq, Show, Ord)++data LexemeRanking+ = LexemeRanking { position :: Int, weight :: Char }+ deriving (Eq, Show, Ord)++instance FromField TSVector where+ fromField f v =+ if typeOid f /= $(inlineTypoid tsvector)+ then returnError Incompatible f ""+ else case v of+ Nothing -> returnError UnexpectedNull f ""+ Just bs ->+ case parseOnly parseTSVector bs of+ Left err -> returnError ConversionFailed f err+ Right val -> pure val++-- 'a:1A fat:2B,4C cat:5D'+-- 'descript':4 'one':1,3 'titl':2+parseTSVector :: Parser ByteString TSVector+parseTSVector = TSVector <$> many' parseLexeme+ where+ parseLexeme = do+ skipSpace++ char '\''+ token <- Attoparsec.takeWhile (/= '\'')+ char '\''++ char ':'+ ranking <- many1 do+ skipMany $ char ','++ position <- double+ -- The Default Weight Is `D` So Postgres Does Not Include It In The Result+ weight <- option 'D' $ choice [char 'A', char 'B', char 'C', char 'D']+ pure $ LexemeRanking { position = truncate position, weight }++ pure $ Lexeme { token = Text.decodeUtf8 token, ranking }+++instance ToField TSVector where+ toField = serializeTSVector++serializeTSVector :: TSVector -> Action+serializeTSVector (TSVector lexemes) = Many $ map serializeLexeme lexemes+ where+ serializeLexeme Lexeme { token, ranking } = Many+ [ Plain $ byteString $ Text.encodeUtf8 token+ , toField ':'+ , Many $ intersperse (toField ',') (map serializeLexemeRanking ranking)+ ]+ serializeLexemeRanking LexemeRanking { position, weight } = Many [toField position, toField weight]++instance ToField Char where+ toField char = Plain $ charUtf8 char
+ IHP/Postgres/TimeParser.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes, RecordWildCards #-}+module IHP.Postgres.TimeParser where++import BasicPrelude hiding (takeWhile)+import Data.Attoparsec.ByteString.Char8+import Data.Bits ((.&.))+import Data.Char (ord)++import Data.Fixed (Pico, Fixed(MkFixed))+import Data.Time.Clock.Compat (NominalDiffTime)+import qualified Data.ByteString.Char8 as B8+import qualified Data.Time.LocalTime.Compat as Local++--Simple newtype wrapper around a postgres interval bytestring.+newtype PGInterval = PGInterval ByteString deriving (Eq, Show)++-- The mapping of the "interval" bytestring into application+-- logic depends on the Interval Output Style of the postgres database+-- and the semantics of the interval quantity in the application code (if they differ from the postgres+-- interpretation for some reason).+-- This module provides the PGInterval wrapper type and a parser for the default+-- `postgres` output style into a a PGTimeInterval data struct of years, months, days, and NominalDiffTime.+-- These can be combined with the standard Calendar/Time library to perform Calendar Arithmetic+-- Days and Years are big Integers and can be added to the Gregorian year and Julian Day respectively+-- Months are small Int (up to 1-11) denoting a month of the year, and the pgClock is a Nominal DiffTime+-- representing the time as measured by a clock without leap seconds.++data PGTimeInterval = PGTimeInterval { pgYears :: !Integer+ , pgMonths :: !Int+ , pgDays :: !Integer+ , pgClock :: !NominalDiffTime } deriving (Eq, Show)++-- To support the default postgres output style PGInterval -> PGTimeInterval+-- in Application Code we provide the parser combinators for the `postgres` output style.+-- for parsing (optional combination of): Y year[s] M mon[s] D day[s] [-]HH:MM:SS.[SSSs].+-- This corresponds to the default interval `postgres` format.+-- (https://www.postgresql.org/docs/current/datatype-datetime.html).+-- alternative parsers would need to be provided for the `sql_standard`, `postgres_verbose`, and `iso_8601`+-- styles/++unpackInterval :: PGInterval -> PGTimeInterval+unpackInterval (PGInterval bs) = case parseOnly pPGInterval bs of+ Left err -> error ("Couldn't parse PGInterval. " <> err)+ Right val -> val+++pPGInterval :: Parser PGTimeInterval+pPGInterval = do+ year <- option 0 ((signed decimal <* space <* (string "years" <|> string "year")))+ skipSpace+ mons <- option 0 ((signed decimal <* space <* (string "mons" <|> string "mon")))+ skipSpace+ days <- option 0 ((signed decimal <* space <* (string "days" <|> "day")))+ skipSpace+ timeOfDay <- option 0 nominalDiffTime+ pure (PGTimeInterval year mons days timeOfDay)+++-- | Parse a two-digit integer (e.g. day of month, hour).+twoDigits :: Parser Int+twoDigits = do+ a <- digit+ b <- digit+ let c2d c = ord c .&. 15+ pure $! c2d a * 10 + c2d b+++-- Take from Postgresql Internal to facilitate a definition of a NominalDiffTime FromField+-- | See https://stackoverflow.com/questions/32398878/converting-postgres-interval-to-haskell-nominaltimediff-with-postgresql-simple+-- |+-- Module: Database.PostgreSQL.Simple.Time.Internal.Parser+-- Copyright: (c) 2012-2015 Leon P Smith+-- (c) 2015 Bryan O'Sullivan+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- Parsers for parsing dates and times.++toPico :: Integer -> Pico+toPico = MkFixed+-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.++pClockInterval :: Parser Local.TimeOfDay+pClockInterval = do+ h <- twoDigits <* char ':'+ m <- twoDigits+ mc <- peekChar+ s <- case mc of+ Just ':' -> anyChar *> seconds+ _ -> return 0+ if h < 24 && m < 60 && s <= 60+ then return (Local.TimeOfDay h m s)+ else fail "invalid time"++-- | Parse a count of seconds, with the integer part being two digits+-- long.+seconds :: Parser Pico+seconds = do+ real <- twoDigits+ mc <- peekChar+ case mc of+ Just '.' -> do+ t <- anyChar *> takeWhile1 isDigit+ pure $! parsePicos (fromIntegral real) t+ _ -> pure $! fromIntegral real+ where+ parsePicos :: Int64 -> B8.ByteString -> Pico+ parsePicos a0 t = toPico (fromIntegral (t' * 10^n))+ where n = max 0 (12 - B8.length t)+ t' = B8.foldl' (\a c -> 10 * a + fromIntegral (ord c .&. 15)) a0+ (B8.take 12 t)++nominalDiffTime :: Parser NominalDiffTime+nominalDiffTime = do+ (h, m, s) <- pClockTime+ pure . fromRational . toRational $ s + 60*(fromIntegral m) + 60*60*(fromIntegral h)+++-- | Parse a limited postgres interval of the form [-]HHH:MM:SS.[SSSS] (no larger units than hours).+pClockTime :: Parser (Int, Int, Pico)+pClockTime = do+ h <- try $ signed decimal <* char ':'+ m <- try $ twoDigits <* char ':'+ s <- try seconds+ pure (h,m,s)
+ IHP/Postgres/TypeInfo.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell #-}+{-|+Module: IHP.Postgres.TypeInfo+Description: Extension Of The Database.PostgreSQL.Simple.TypeInfo Module+Copyright: (c) digitally induced GmbH, 2021+-}+module IHP.Postgres.TypeInfo where++import Database.PostgreSQL.Simple.FromField++tsvector :: TypeInfo+tsvector = Basic {+ typoid = tsvectorOid,+ typcategory = 'U',+ typdelim = ',',+ typname = "tsvector"+ }++-- `SELECT oid, typname FROM pg_type WHERE typname ~ 'tsvector';`+tsvectorOid :: Oid+tsvectorOid = Oid 3614+{-# INLINE tsvector #-}
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 digitally induced GmbH++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.
+ README.md view
@@ -0,0 +1,9 @@+# ihp-postgres-simple-extra++This package is included by default in IHP apps and implements support for postgres data types that are not supported by the `postgresql-simple` package by default:++- `INET`+- `INTERVAL`+- `POINT`+- `POLYGON`+- `TSVECTOR`
+ Test/Postgres/Interval.hs view
@@ -0,0 +1,21 @@+{-|+Module: Test.Postgres.Interval+Copyright: (c) digitally induced GmbH, 2023+-}+module Test.Postgres.Interval where++import Test.Hspec+import IHP.Postgres.Interval+import IHP.Postgres.TimeParser+import Database.PostgreSQL.Simple.ToField+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec++tests = do+ describe "Interval" do+ describe "Parser" do+ it "Should Parse" do+ unpackInterval (PGInterval "25 years 6 mons 4 days 114:00:00.123") `shouldBe` (PGTimeInterval 25 6 4 410400.123)+ it "Should Parse" do+ unpackInterval (PGInterval "25 years 01:00:00") `shouldBe` (PGTimeInterval 25 0 0 3600)+ it "Should Parse" do+ unpackInterval (PGInterval "11 years 10 mons 683 days") `shouldBe` (PGTimeInterval 11 10 683 0)
+ Test/Postgres/Point.hs view
@@ -0,0 +1,26 @@+{-|+Module: Test.Postgres.Point+Copyright: (c) digitally induced GmbH, 2021+-}+module Test.Postgres.Point where++import Data.Either+import Test.Hspec+import Test.Postgres.Support ()+import IHP.Postgres.Point+import Database.PostgreSQL.Simple.ToField+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec++tests = do+ let raw = "(100,200)"+ let parsed = Point { x = 100.0, y = 200.0 }+ let serialized = Many [ Plain "point(", Plain "100.0", Plain ",", Plain "200.0",Plain ")" ]++ describe "Point" do+ describe "Parser" do+ it "Should Parse" do+ Attoparsec.parseOnly parsePoint raw `shouldBe` Right parsed++ describe "Serializer" do+ it "Should Serialize" do+ serializePoint parsed `shouldBe` serialized
+ Test/Postgres/Polygon.hs view
@@ -0,0 +1,50 @@+{-|+Module: Test.Postgres.Polygon+Copyright: (c) digitally induced GmbH, 2022+-}+module Test.Postgres.Polygon where++import CorePrelude+import Data.Either+import Test.Hspec+import Test.Postgres.Support+import IHP.Postgres.Point+import IHP.Postgres.Polygon+import Database.PostgreSQL.Simple.ToField+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec++tests = do+ let rawPoint1 = "(100,200)"+ let parsedPoint1 = Point { x = 100, y = 200 }+ let rawPoint2 = "(300,400)"+ let parsedPoint2 = Point { x = 300, y = 400 }+ let raw = "(" <> rawPoint1 <> "," <> rawPoint2 <> ")"+ let parsed = Polygon { points = [ parsedPoint1, parsedPoint2 ] }+ let serialized = Many+ [ Plain "polygon'"+ , Many+ [ Plain "("+ , Plain "100.0"+ , Plain ","+ , Plain "200.0"+ , Plain ")"+ ]+ , Plain ","+ , Many+ [ Plain "("+ , Plain "300.0"+ , Plain ","+ , Plain "400.0"+ , Plain ")"+ ]+ , Plain "'"+ ]++ describe "Polygon" do+ describe "Parser" do+ it "Should Parse" do+ Attoparsec.parseOnly parsePolygon raw `shouldBe` Right parsed++ describe "Serializer" do+ it "Should Serialize" do+ serializePolygon parsed `shouldBe` serialized
+ Test/Postgres/Support.hs view
@@ -0,0 +1,15 @@+{-|+Module: Test.Postgres.Support+Copyright: (c) digitally induced GmbH, 2021+-}+module Test.Postgres.Support where++import Prelude+import Data.ByteString.Builder (toLazyByteString)+import Database.PostgreSQL.Simple.ToField+import qualified Data.ByteString.Builder as Builder++deriving instance Eq Action++instance Eq Builder.Builder where+ a == b = (Builder.toLazyByteString a) == (Builder.toLazyByteString b)
+ Test/Postgres/TSVector.hs view
@@ -0,0 +1,44 @@+{-|+Module: Test.Postgres.TSVector+Copyright: (c) digitally induced GmbH, 2021+-}+module Test.Postgres.TSVector where++import Prelude+import Test.Hspec+import Test.Postgres.Support+import IHP.Postgres.TSVector+import Database.PostgreSQL.Simple.ToField+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec++tests = do+ let raw = "'dummi':9 'industri':16 'ipsum':4,6 'lorem':3,5 'print':13 'simpli':8 'text':10 'typeset':15"+ let parsed = TSVector+ [ Lexeme { token = "dummi", ranking = [ LexemeRanking { position = 9, weight = 'D'} ] }+ , Lexeme { token = "industri", ranking = [ LexemeRanking { position = 16, weight = 'D' } ] }+ , Lexeme { token = "ipsum", ranking = [ LexemeRanking { position = 4, weight = 'D' }, LexemeRanking { position = 6, weight = 'D'} ] }+ , Lexeme { token = "lorem", ranking = [ LexemeRanking { position = 3, weight = 'D' }, LexemeRanking { position = 5, weight = 'D'} ] }+ , Lexeme { token = "print", ranking = [ LexemeRanking { position = 13, weight = 'D' } ] }+ , Lexeme { token = "simpli", ranking = [ LexemeRanking { position = 8, weight = 'D' } ] }+ , Lexeme { token = "text", ranking = [ LexemeRanking { position = 10, weight = 'D' } ] }+ , Lexeme { token = "typeset", ranking = [ LexemeRanking { position = 15, weight = 'D' } ] }+ ]+ let serialized = Many+ [ Many [ Plain "dummi", Plain ":", Many [ Many [ Plain "9", Plain "D" ] ] ]+ , Many [ Plain "industri", Plain ":", Many [ Many [ Plain "16", Plain "D" ] ] ]+ , Many [ Plain "ipsum", Plain ":", Many [ Many [ Plain "4", Plain "D" ], Plain ",", Many [ Plain "6", Plain "D" ] ] ]+ , Many [ Plain "lorem", Plain ":", Many [ Many [ Plain "3", Plain "D" ], Plain ",", Many [ Plain "5", Plain "D" ] ] ]+ , Many [ Plain "print", Plain ":", Many [ Many [ Plain "13", Plain "D" ] ] ]+ , Many [ Plain "simpli", Plain ":", Many [ Many [ Plain "8", Plain "D" ] ] ]+ , Many [ Plain "text", Plain ":", Many [ Many [ Plain "10", Plain "D" ] ] ]+ , Many [ Plain "typeset", Plain ":", Many [ Many [ Plain "15", Plain "D" ] ] ]+ ]++ describe "TSVector" do+ describe "Parser" do+ it "Should Parse" do+ Attoparsec.parseOnly parseTSVector raw `shouldBe` Right parsed++ describe "Serializer" do+ it "Should Serialize" do+ serializeTSVector parsed `shouldBe` serialized
+ Test/Spec.hs view
@@ -0,0 +1,16 @@+module Main where++import CorePrelude+import Test.Hspec++import qualified Test.Postgres.Point+import qualified Test.Postgres.Polygon+import qualified Test.Postgres.Interval+import qualified Test.Postgres.TSVector++main :: IO ()+main = hspec do+ Test.Postgres.Point.tests+ Test.Postgres.Polygon.tests+ Test.Postgres.Interval.tests+ Test.Postgres.TSVector.tests
+ ihp-postgresql-simple-extra.cabal view
@@ -0,0 +1,93 @@+cabal-version: 2.2+name: ihp-postgresql-simple-extra+version: 1.3.0+synopsis: Extra data types for postgresql-simple+description: This package is included by default in IHP apps and implements support for postgres data types that are not supported by the postgresql-simple package by default+license: MIT+license-file: LICENSE+author: digitally induced GmbH+maintainer: support@digitallyinduced.com+bug-reports: https://github.com/digitallyinduced/ihp/issues+category: Database+build-type: Simple+extra-source-files: README.md++source-repository head+ type: git+ location: https://github.com/digitallyinduced/ihp.git++common shared-properties+ default-language: Haskell2010+ build-depends:+ base >= 4.17.0 && < 4.22+ , bytestring+ , attoparsec+ , basic-prelude+ , text+ , postgresql-simple+ , ip+ , time+ , time-compat+ , aeson+ default-extensions:+ OverloadedStrings+ , NoImplicitPrelude+ , ImplicitParams+ , Rank2Types+ , NamedFieldPuns+ , TypeSynonymInstances+ , FlexibleInstances+ , DisambiguateRecordFields+ , DuplicateRecordFields+ , OverloadedLabels+ , FlexibleContexts+ , DataKinds+ , QuasiQuotes+ , TypeFamilies+ , PackageImports+ , ScopedTypeVariables+ , RecordWildCards+ , TypeApplications+ , DataKinds+ , InstanceSigs+ , DeriveGeneric+ , MultiParamTypeClasses+ , TypeOperators+ , DeriveDataTypeable+ , DefaultSignatures+ , BangPatterns+ , FunctionalDependencies+ , PartialTypeSignatures+ , BlockArguments+ , LambdaCase+ , StandaloneDeriving+ , TemplateHaskell+ , OverloadedRecordDot++library+ import: shared-properties+ hs-source-dirs: .+ exposed-modules:+ IHP.Postgres.TypeInfo+ , IHP.Postgres.Point+ , IHP.Postgres.Interval+ , IHP.Postgres.TimeParser+ , IHP.Postgres.Polygon+ , IHP.Postgres.Inet+ , IHP.Postgres.TSVector++test-suite spec+ import: shared-properties+ type: exitcode-stdio-1.0+ other-modules:+ Test.Postgres.Interval+ , Test.Postgres.Point+ , Test.Postgres.Polygon+ , Test.Postgres.Support+ , Test.Postgres.TSVector+ hs-source-dirs: .+ main-is: Test/Spec.hs+ build-depends:+ hspec >= 2.7+ , hspec-discover >= 2.7+ , ihp-postgresql-simple-extra