92094a8 · squeal · git.iko.soy

git.iko.soy/squeal

test me docs

commit92094a8c953eaea396fe16c5fc9cf73f643554b8 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 18 Aug 2017, 09:50 (9 years ago) parent21b9167

5 files changed+49−12

compare with dev

unifiedsplit

squeal-postgresql/squeal-postgresql.cabal+10 squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+18−7 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1 squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+10−5 squeal-postgresql/test/DocTest.hs+10

squeal-postgresql/squeal-postgresql.cabal+10

@@ -53,6 +53,16 @@ test-suite squeal-postgresql-test

5353 , hspec

5454 , squeal-postgresql

5555

56+test-suite squeal-postgresql-doctest

57+ default-language: Haskell2010

58+ type: exitcode-stdio-1.0

59+ hs-source-dirs: test

60+ ghc-options: -Wall -Werror

61+ main-is: DocTest.hs

62+ build-depends:

63+ base

64+ , doctest

65+

5666executable squeal-postgresql-example

5767 default-language: Haskell2010

5868 hs-source-dirs: exe

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+18−7

@@ -76,7 +76,8 @@ class ToParam (x :: Type) (pg :: PGType) where

7676 -- >>> toParam @Int32 @'PGint4 0

7777 -- K "\NUL\NUL\NUL\NUL"

7878 --

79− -- >>> data Id = Id { getId :: Int16 } deriving Show

79+ -- >>> :set -XMultiParamTypeClasses

80+ -- >>> newtype Id = Id { getId :: Int16 } deriving Show

8081 -- >>> instance ToParam Id 'PGint2 where toParam = toParam . getId

8182 -- >>> toParam @Id @'PGint2 (Id 1)

8283 -- K "\NUL\SOH"

@@ -136,8 +137,9 @@ class SListI tys => ToParams (x :: Type) (tys :: [ColumnType]) where

136137 -- >>> toParams @(Bool, Maybe Int16) @PGparams (False, Just 0)

137138 -- K (Just "\NUL") :* (K (Just "\NUL\NUL") :* Nil)

138139 --

140+ -- >>> :set -XDeriveGeneric

139141 -- >>> data Hparams = Hparams { col1 :: Bool, col2 :: Maybe Int16} deriving GHC.Generic

140− -- >>> instance SOP.Generic Hparams

142+ -- >>> instance Generic Hparams

141143 -- >>> toParams @Hparams @PGparams (Hparams False (Just 0))

142144 -- K (Just "\NUL") :* (K (Just "\NUL\NUL") :* Nil)

143145 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys

@@ -150,7 +152,8 @@ instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)

150152-- | A `FromValue` constraint gives a parser from the binary format of

151153-- a PostgreSQL `PGType` into a Haskell `Type`.

152154class FromValue (pg :: PGType) (y :: Type) where

153− -- | >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

155+ -- | >>> newtype Id = Id { getId :: Int16 } deriving Show

156+ -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

154157 fromValue :: proxy pg -> Decoding.Value y

155158instance FromValue 'PGbool Bool where fromValue _ = Decoding.bool

156159instance FromValue 'PGint2 Int16 where fromValue _ = Decoding.int

@@ -185,7 +188,10 @@ instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast

185188-- to a decoding of a `(Symbol,ColumnType)` to a `Type`,

186189-- decoding `Null`s to `Maybe`s.

187190class FromColumnValue (colty :: (Symbol,ColumnType)) (y :: Type) where

188− -- | >>> fromColumnValue @("col" ::: 'Required ('NotNull 'PGint2)) @Id (K (Just "\NUL\SOH"))

191+ -- | >>> :set -XTypeOperators -XOverloadedStrings

192+ -- >>> newtype Id = Id { getId :: Int16 } deriving Show

193+ -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

194+ -- >>> fromColumnValue @("col" ::: 'Required ('NotNull 'PGint2)) @Id (K (Just "\NUL\SOH"))

189195 -- Id {getId = 1}

190196 --

191197 -- >>> fromColumnValue @("col" ::: 'Required ('Null 'PGint2)) @(Maybe Id) (K (Just "\NUL\SOH"))

@@ -215,9 +221,13 @@ instance FromValue pg y

215221-- of a `ColumnsType` into the fields of a record `Type` provided they have

216222-- the same field names.

217223class SListI results => FromRow (results :: ColumnsType) y where

218− -- | >>> data Hrow = Hrow { userId :: Id, userName :: Maybe Text } deriving (Show, GHC.Generic)

219− -- >>> instance SOP.Generic Hrow

220− -- >>> instance SOP.HasDatatypeInfo Hrow

224+ -- | :set -XOverloadedStrings

225+ -- >>> import Data.Text

226+ -- >>> newtype Id = Id { getId :: Int16 } deriving Show

227+ -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

228+ -- >>> data Hrow = Hrow { userId :: Id, userName :: Maybe Text } deriving (Show, GHC.Generic)

229+ -- >>> instance Generic Hrow

230+ -- >>> instance HasDatatypeInfo Hrow

221231 -- >>> type PGrow = '["userId" ::: 'Required ('NotNull 'PGint2), "userName" ::: 'Required ('Null 'PGtext)]

222232 -- >>> fromRow @PGrow @Hrow (K (Just "\NUL\SOH") :* K (Just "bloodninja") :* Nil)

223233 -- Hrow {userId = Id {getId = 1}, userName = Just "bloodninja"}

@@ -234,6 +244,7 @@ instance

234244-- | `Only` is a 1-tuple type, useful for encoding a single parameter with

235245-- `toParams` or decoding a single value with `fromRow`.

236246--

247+-- >>> import Data.Text

237248-- >>> toParams @(Only (Maybe Text)) @'[ 'Required ('Null 'PGtext)] (Only (Just "foo"))

238249-- K (Just "foo") :* Nil

239250--

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1

@@ -162,6 +162,7 @@ type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)

162162-- | `Alias`es are proxies for a type level string or `Symbol`

163163-- and have an `IsLabel` instance so that with @-XOverloadedLabels@

164164--

165+-- >>> :set -XOverloadedLabels

165166-- >>> #foobar :: Alias "foobar"

166167-- Alias

167168data Alias (alias :: Symbol) = Alias

squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+10−5

@@ -216,6 +216,9 @@ module Squeal.PostgreSQL.Statement

216216 , renderUpdateExpression

217217 , update

218218 , deleteFrom

219+ -- * Re-export

220+ , (&)

221+ , NP ((:*), Nil)

219222 ) where

220223

221224import Control.Category

@@ -223,6 +226,7 @@ import Control.DeepSeq

223226import Data.ByteString (ByteString)

224227import Data.Data (Data)

225228import Data.Foldable

229+import Data.Function ((&))

226230import Data.Maybe

227231import Data.Monoid hiding (All)

228232import Data.Ratio

@@ -384,7 +388,7 @@ isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"

384388

385389-- | analagous to `maybe` using @IS NULL@

386390--

387−-- >>> renderExpression $ matchNull true not null_

391+-- >>> renderExpression $ matchNull true not_ null_

388392-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT TRUE) END"

389393matchNull

390394 :: Expression params tables grouping ('Required nullty)

@@ -395,10 +399,11 @@ matchNull

395399matchNull y f x = ifThenElse (isNull x) y

396400 (f (UnsafeExpression (renderExpression y)))

397401

398−-- | left inverse to `fromNull`

402+-- | right inverse to `fromNull`

399403--

400−-- >>> renderExpression $ nullIf false (fromNull false null_)

401−-- "NULL IF (FALSE, COALESCE(NULL, FALSE))"

404+-- >>> :set -XTypeApplications -XDataKinds

405+-- >>> renderExpression @'[_] $ fromNull false (nullIf false (param @1))

406+-- "COALESCE(NULL IF (FALSE, ($1 :: bool)), FALSE)"

402407nullIf

403408 :: Expression params tables grouping ('Required ('NotNull ty))

404409 -> Expression params tables grouping ('Required ('NotNull ty))

@@ -406,7 +411,7 @@ nullIf

406411nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized

407412 (renderExpression x <> ", " <> renderExpression y)

408413

409−-- | >>> renderExpression $ greatest @'[_] currentTimestamp [param (Proxy @1)]

414+-- | >>> renderExpression @'[_] $ greatest currentTimestamp [param @1]

410415-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"

411416greatest

412417 :: Expression params tables grouping ('Required nullty)

squeal-postgresql/test/DocTest.hsnew file+10

@@ -0,0 +1,10 @@

1+module Main (main) where

3+import Test.DocTest

5+main :: IO ()

6+main = doctest

7+ [ "-isrc"

8+ , "src/Squeal/PostgreSQL/Binary.hs"

9+ , "src/Squeal/PostgreSQL/Statement.hs"

10+ ]