packages feed

polysemy-hasql-test (empty) → 0.0.1.0

raw patch · 8 files changed

+541/−0 lines, 8 filesdep +aesondep +basedep +chronossetup-changed

Dependencies added: aeson, base, chronos, exon, first-class-families, generics-sop, hasql, hedgehog, path, polysemy, polysemy-db, polysemy-hasql, polysemy-hasql-test, polysemy-plugin, polysemy-test, prelate, sqel, tasty, uuid

Files

+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2023 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. 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.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++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 HOLDERS 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
+ lib/Polysemy/Hasql/Test.hs view
@@ -0,0 +1,7 @@+module Polysemy.Hasql.Test (+  module Polysemy.Hasql.Test.Run,+  module Polysemy.Hasql.Test.Migration,+) where++import Polysemy.Hasql.Test.Run (integrationTest, integrationTestWith, runIntegrationTestWith, dbConfig)+import Polysemy.Hasql.Test.Migration
+ lib/Polysemy/Hasql/Test/Migration.hs view
@@ -0,0 +1,33 @@+module Polysemy.Hasql.Test.Migration where++import qualified Data.Text as Text+import Hedgehog.Internal.Property (failWith)+import Path (reldir)+import qualified Polysemy.Test as Test+import Polysemy.Test (Hedgehog, Test, liftH)+import Sqel.Data.Migration (Migrations)+import Sqel.Migration.Consistency (migrationConsistency)++testMigration' ::+  ∀ migs r .+  Members [Test, Hedgehog IO, Embed IO] r =>+  Migrations (Sem r) migs ->+  Bool ->+  Sem r ()+testMigration' migs write =+  withFrozenCallStack do+    dir <- Test.fixturePath [reldir|migration|]+    migrationConsistency dir migs write >>= \case+      Just errors ->+        liftH (failWith Nothing (toString (Text.intercalate "\n" (toList errors))))+      Nothing -> unit++testMigration ::+  ∀ migs r .+  Members [Test, Hedgehog IO, Embed IO] r =>+  Migrations (Sem r) migs ->+  Bool ->+  Sem r ()+testMigration migs write =+  withFrozenCallStack do+    testMigration' migs write
+ lib/Polysemy/Hasql/Test/Run.hs view
@@ -0,0 +1,116 @@+module Polysemy.Hasql.Test.Run where++import Conc (interpretMaskFinal, interpretRace)+import Data.UUID (UUID)+import Exon (exon)+import Hasql.Session (QueryError)+import Hedgehog (TestT)+import Hedgehog.Internal.Property (Failure)+import Log (Severity (Error), interpretLogStdoutLevelConc)+import Polysemy.Db (interpretRandom)+import Polysemy.Db.Data.DbConfig (DbConfig (DbConfig))+import Polysemy.Db.Data.DbConnectionError (DbConnectionError)+import Polysemy.Db.Data.DbError (DbError)+import Polysemy.Db.Data.InitDbError (InitDbError)+import Polysemy.Db.Effect.Random (Random)+import qualified Polysemy.Test as Hedgehog+import Polysemy.Test (Hedgehog, Test, runTestAuto)+import Polysemy.Test.Data.TestError (TestError)+import Time (GhcTime, interpretTimeGhc)+import System.Environment (lookupEnv)++import Polysemy.Hasql.Test.Database (TestConnectionEffects, withTestConnection)++type DbErrors =+  [+    Stop DbConnectionError,+    Stop DbError,+    Stop QueryError,+    Stop Text,+    Error InitDbError,+    Error DbError+  ]++type TestEffects =+  DbErrors ++ [+    GhcTime,+    Random UUID,+    Log,+    Error Text,+    Mask,+    Race,+    Async,+    Test,+    Fail,+    Error TestError,+    Hedgehog IO,+    Error Failure,+    Embed IO,+    Resource,+    Final IO+  ]++dbConfig ::+  MonadIO m =>+  String ->+  Text ->+  m (Maybe DbConfig)+dbConfig envPrefix name = do+  traverse cons =<< (liftIO (lookupEnv [exon|#{envPrefix}_test_host|]))+  where+    cons host = do+      port <- parsePort =<< (fromMaybe "4321" <$> liftIO (lookupEnv [exon|#{envPrefix}_test_port|]))+      pure (DbConfig (fromString host) port (fromText name) (fromText name) (fromText name))+    parsePort p =+      case readMaybe p of+        Just a -> pure a+        Nothing -> error [exon|invalid port in env var $#{envPrefix}_test_port: #{p}|]++runIntegrationTestWith ::+  Members [Error Text, Embed IO] r =>+  HasCallStack =>+  String ->+  Text ->+  (DbConfig -> Sem (DbErrors ++ r) ()) ->+  Sem r ()+runIntegrationTestWith envPrefix name run =+  withFrozenCallStack do+    dbConfig envPrefix name >>= \case+      Just conf ->+        mapError @DbError @Text show $+        mapError @InitDbError @Text show $+        stopToError @Text $+        mapStop @QueryError @Text show $+        mapStop @DbError @Text show $+        mapStop @DbConnectionError @Text show $+        run conf+      Nothing ->+        unit++integrationTestWith ::+  HasCallStack =>+  String ->+  Text ->+  (DbConfig -> Sem TestEffects ()) ->+  TestT IO ()+integrationTestWith envPrefix name run =+  withFrozenCallStack $ runTestAuto do+    r <- asyncToIOFinal $+      interpretRace $+      interpretMaskFinal $+      runError @Text $+      interpretLogStdoutLevelConc (Just Error) $+      interpretRandom $+      interpretTimeGhc $+      runIntegrationTestWith envPrefix name run+    Hedgehog.evalEither r++integrationTest ::+  HasCallStack =>+  String ->+  Text ->+  Sem (TestConnectionEffects ++ TestEffects) () ->+  TestT IO ()+integrationTest envPrefix name thunk =+  withFrozenCallStack do+    integrationTestWith envPrefix name \ conf -> withTestConnection conf thunk
+ polysemy-hasql-test.cabal view
@@ -0,0 +1,202 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.35.0.+--+-- see: https://github.com/sol/hpack++name:           polysemy-hasql-test+version:        0.0.1.0+synopsis:       Test utilities for polysemy-hasql+description:    See https://hackage.haskell.org/package/polysemy-hasql-test/docs/Polysemy-Hasql-Test.html+category:       Database+author:         Torsten Schmits+maintainer:     hackage@tryp.io+copyright:      2023 Torsten Schmits+license:        BSD-2-Clause-Patent+license-file:   LICENSE+build-type:     Simple++library+  exposed-modules:+      Polysemy.Hasql.Test+      Polysemy.Hasql.Test.Migration+      Polysemy.Hasql.Test.Run+  hs-source-dirs:+      lib+  default-extensions:+      StandaloneKindSignatures+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin+  build-depends:+      base >=4.12 && <5+    , hasql ==1.6.*+    , hedgehog ==1.1.*+    , path ==0.9.*+    , polysemy+    , polysemy-db >=0.0.1.0 && <0.1+    , polysemy-hasql >=0.0.1.0 && <0.1+    , polysemy-plugin+    , polysemy-test ==0.7.*+    , prelate >=0.5.1 && <0.6+    , sqel >=0.0.1 && <0.1+    , uuid ==1.3.*+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010++test-suite polysemy-hasql-test-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Polysemy.Hasql.Test.MigrationTest+  hs-source-dirs:+      test+  default-extensions:+      StandaloneKindSignatures+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson ==2.0.*+    , base >=4.12 && <5+    , chronos ==1.1.*+    , exon ==1.4.*+    , first-class-families ==0.8.*+    , generics-sop ==0.5.*+    , hasql ==1.6.*+    , path ==0.9.*+    , polysemy+    , polysemy-db >=0.0.1.0 && <0.1+    , polysemy-hasql >=0.0.1.0 && <0.1+    , polysemy-hasql-test+    , polysemy-plugin+    , polysemy-test ==0.7.*+    , prelate >=0.5.1 && <0.6+    , sqel >=0.0.1 && <0.1+    , tasty ==1.4.*+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,16 @@+module Main where++import Polysemy.Hasql.Test.MigrationTest (test_migrationConsistency, test_migrationErrors)+import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "all" [+    unitTest "migration errors" test_migrationErrors,+    unitTest "migration consistency" test_migrationConsistency+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Polysemy/Hasql/Test/MigrationTest.hs view
@@ -0,0 +1,131 @@+{-# options_ghc -Wno-partial-type-signatures #-}++module Polysemy.Hasql.Test.MigrationTest where++import Path (reldir)+import qualified Polysemy.Test as Test+import Polysemy.Test (UnitTest, assertJust, runTestAuto)+import Prelude hiding (sum)+import Sqel.Data.Dd (Dd, DdK (DdK), type (:>) ((:>)))+import Sqel.Data.Migration (AutoMigrations, migrate)+import Sqel.Data.Uid (Uid)+import Sqel.Migration.Consistency (migrationConsistency)+import Sqel.Migration.Table (migrateAuto)+import Sqel.Names (typeAs)+import Sqel.Prim (migrateDef, migrateDelete, migrateRename, prim, primNullable)+import Sqel.Product (prod)+import Sqel.Uid (uidAs)++import Polysemy.Hasql.Test.Migration (testMigration)++data PordOld =+  PordOld {+    p1 :: Int64+  }+  deriving stock (Eq, Show, Generic)++data Pord =+  Pord {+    p1 :: Int64,+    p2 :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)++data Dat0 =+  Dat0 {+    old :: Text+  }+  deriving stock (Eq, Show, Generic)++data Dat1 =+  Dat1 {+    size :: Int64,+    pord :: PordOld+  }+  deriving stock (Eq, Show, Generic)++data Dat2 =+  Dat2 {+    number :: Int64,+    pord :: Pord+  }+  deriving stock (Eq, Show, Generic)++data Dat =+  Dat {+    name :: Text,+    num :: Int64,+    pord :: Pord+  }+  deriving stock (Eq, Show, Generic)++data Q =+  Q {+    name :: Text+  }+  deriving stock (Eq, Show, Generic)++t0 :: Dd ('DdK _ _ (Uid Int64 Dat0) _)+t0 =+  uidAs @"dat" prim (prod (migrateDelete prim))++t1 :: Dd ('DdK _ _ (Uid Int64 Dat1) _)+t1 =+  uidAs @"dat" prim (prod (+    migrateDelete (migrateDef 0 prim) :>+    typeAs @"Pord" (prod (+      migrateDef 53 prim+    ))+  ))++t2 :: Dd ('DdK _ _ (Uid Int64 Dat2) _)+t2 =+  uidAs @"dat" prim (prod (+    migrateDef 15 prim :>+    typeAs @"Pord" (prod (+      prim :>+      primNullable+    ))+  ))++tcur :: Dd ('DdK _ _ (Uid Int64 Dat) _)+tcur =+  uidAs @"dat" prim (prod (+    migrateDef ("vunqach" :: Text) prim :>+    migrateRename @"number" prim :>+    prod (+      prim :>+      primNullable+    )+  ))++migrations ::+  AutoMigrations (Sem r) [Uid Int64 Dat2, Uid Int64 Dat1, Uid Int64 Dat0] (Uid Int64 Dat)+migrations =+  migrate (+    migrateAuto t2 tcur :>+    migrateAuto t1 t2 :>+    migrateAuto t0 t1+  )++migrationErrors :: NonEmpty Text+migrationErrors =+  [+    "The migration table 'dat' has mismatched columns:",+    " • The column 'number' with type 'bigint' was removed.",+    "The composite type 'sqel_type__pord' has mismatched columns:",+    " • The type of the column 'p1' was changed from 'text' to 'bigint'.",+    "The type 'sqel_type__point' was removed."+  ]++test_migrationErrors :: UnitTest+test_migrationErrors =+  runTestAuto do+    fixtures <- Test.fixturePath [reldir|migration-error|]+    assertJust migrationErrors =<< migrationConsistency fixtures migrations False++-- TODO error message claims type change if a column constraint differs+test_migrationConsistency :: UnitTest+test_migrationConsistency =+  runTestAuto do+    testMigration migrations False