content: {-# LANGUAGE
      DataKinds
    , DeriveAnyClass
    , DeriveGeneric
    , DerivingStrategies
    , DerivingVia
    , DuplicateRecordFields
    , FlexibleContexts
    , FlexibleInstances
    , MultiParamTypeClasses
    , OverloadedLabels
    , OverloadedStrings
    , RankNTypes
    , StandaloneDeriving
    , TypeApplications
    , TypeFamilies
    , TypeSynonymInstances
    , DataKinds
    , PolyKinds
    , TypeOperators
    , UndecidableInstances
  #-}
  
  module Main (main) where
  
  import Control.Concurrent.Async (replicateConcurrently)
  import Data.ByteString (ByteString)
  import Data.Int (Int32)
  import Data.Text (Text)
  import Test.Hspec
  
  import qualified Data.ByteString.Char8 as Char8 (unlines)
  import qualified Generics.SOP as SOP
  import qualified GHC.Generics as GHC
  
  import Squeal.PostgreSQL
  
  main :: IO ()
  main = hspec spec
  
  type UsersConstraints =
    '[ "pk_users" ::: 'PrimaryKey '["id"]
     , "unique_names" ::: 'Unique '["name"] ]
  
  type UsersColumns =
    '[ "id" ::: 'Def :=> 'NotNull 'PGint4
     , "name" ::: 'NoDef :=> 'NotNull 'PGtext ]
  
  type Schema =
    '[ "users" ::: 'Table (UsersConstraints :=> UsersColumns)
     , "person" ::: 'Typedef (PG Person) ]
  
  type DB = '[ "public" ::: Schema ]
  
  data User = User
    { userName  :: Text
    } deriving stock (Eq, Show, GHC.Generic)
      deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
  
  insertUser :: Manipulation_ DB User ()
  insertUser = insertInto_ #users
    (Values_ (Default `as` #id :* Set (param @1) `as` #name))
  
  insertUsers :: Text -> [Text] -> Statement DB () ()
  insertUsers name1 names = manipulation $ insertInto_ #users $ Values
    (Default `as` #id :* Set (inline name1) `as` #name)
    [Default `as` #id :* Set (inline namei) `as` #name | namei <- names]
  
  deleteUser :: Text -> Statement DB () ()
  deleteUser name1 = manipulation $ deleteFrom_ #users (#name .== inline name1)
  
  setup :: Definition (Public '[]) DB
  setup =
    createTable #users
      ( serial `as` #id :*
        notNullable text `as` #name )
      ( primaryKey #id `as` #pk_users :*
        unique #name `as` #unique_names ) >>>
    createTypeCompositeFrom @Person #person
  
  teardown :: Definition DB (Public '[])
  teardown = dropType #person >>> dropTable #users
  
  silent :: Statement db () ()
  silent = manipulation $ UnsafeManipulation "Set client_min_messages TO WARNING"
  
  silence :: MonadPQ db pq => pq ()
  silence = execute_ silent
  
  setupDB :: IO ()
  setupDB = withConnection connectionString $
    silence & pqThen (define setup)
  
  dropDB :: IO ()
  dropDB = withConnection connectionString $
    silence & pqThen (define teardown)
  
  connectionString :: ByteString
  connectionString = "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
  
  data Person = Person { name :: Maybe String, age :: Maybe Int32 }
    deriving (Eq, Show, GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
    deriving (IsPG, FromPG, ToPG db, Inline) via (Composite Person)
  
  spec :: Spec
  spec = before_ setupDB . after_ dropDB $ do
  
    describe "Exceptions" $ do
  
      let
        testUser = User "TestUser"
        newUser :: User -> Transaction DB ()
        newUser usr = manipulateParams_ insertUser usr
        insertUserTwice :: Transaction DB ()
        insertUserTwice = newUser testUser >> newUser testUser
        err23505 = UniqueViolation $ Char8.unlines
          [ "ERROR:  duplicate key value violates unique constraint \"unique_names\""
          , "DETAIL:  Key (name)=(TestUser) already exists." ]
  
      it "should be thrown for constraint violation" $
        withConnection connectionString insertUserTwice
         `shouldThrow` (== err23505)
  
      it "should be rethrown for constraint violation in a transaction" $
        withConnection connectionString (transactionally_ insertUserTwice)
         `shouldThrow` (== err23505)
  
    describe "Pools" $
  
      it "should manage concurrent transactions" $ do
        pool <- createConnectionPool
          "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" 1 0.5 10
        let
          qry :: Query_ (Public '[]) () (Only Char)
          qry = values_ (inline 'a' `as` #fromOnly)
          session = usingConnectionPool pool $ transactionally_ $
            firstRow =<< runQuery qry
        chrs <- replicateConcurrently 10 session
        chrs `shouldSatisfy` all (== Just (Only 'a'))
  
    describe "Ranges" $
  
      it "should correctly decode ranges" $ do
  
        rangesOut <- withConnection connectionString $ do
          let
            qry :: Query_ (Public '[]) () (Only (Range Int32))
            qry = values
              ( range int4range (atLeast 3) `as` #fromOnly )
              [ range int4range (3 <=..< 5) `as` #fromOnly
              , range int4range Empty `as` #fromOnly
              , range int4range whole `as` #fromOnly ]
          getRows =<< runQuery qry
        (fromOnly <$> rangesOut :: [Range Int32]) `shouldBe`
          [ atLeast 3, 3 <=..< 5, Empty, whole ]
  
    describe "Parameters" $ do
  
      it "should run queries that don't reference all their parameters" $ do
  
        out <- withConnection connectionString $ do
          let
            qry :: Query_ (Public '[]) (Char,Int32) (Only Int32)
            qry = values_ (param @2 `as` #fromOnly)
          firstRow =<< runQueryParams qry ('a', 3 :: Int32)
        (fromOnly <$> out :: Maybe Int32) `shouldBe` Just 3
  
    describe "Composite types" $ do
  
      it "should be embeddible" $ do
  
        let
  
          roundtrip :: Query_ DB (Only Person) (Only Person)
          roundtrip = values_ (param @1 `as` #fromOnly)
  
          roundtrip_inline :: Person -> Query_ DB () (Only Person)
          roundtrip_inline person = values_ (inline person `as` #fromOnly)
  
          roundtrip_array :: Query_ DB
            (Only (VarArray [Person])) (Only (VarArray [Person]))
          roundtrip_array = values_ (param @1 `as` #fromOnly)
  
          oneway :: Query_ DB () (Only Person)
          oneway = values_ (row ("Adam" `as` #name :* 6000 `as` #age) `as` #fromOnly)
  
          oneway_array :: Query_ DB () (Only (VarArray [Person]))
          oneway_array = values_ $ array
            [ row ("Adam" `as` #name :* 6000 `as` #age)
            , row ("Lucy" `as` #name :* 2420000 `as` #age)
            ] `as` #fromOnly
  
          unsafeQ :: Query_ DB () (Only (VarArray [Composite Person]))
          unsafeQ = UnsafeQuery "select array[row(\'Adam\', 6000)]"
  
          nothingQ :: Query_ DB () (Only Person)
          nothingQ = values_ (row (null_ `as` #name :* null_ `as` #age) `as` #fromOnly)
  
          adam = Person (Just "Adam") (Just 6000)
          lucy = Person (Just "Lucy") (Just 2420000)
          people = VarArray [adam, lucy]
  
        out <- withConnection connectionString $
          firstRow =<< runQueryParams roundtrip (Only adam)
        out_inline <- withConnection connectionString $
          firstRow =<< runQuery (roundtrip_inline adam)
        out_array <- withConnection connectionString $
          firstRow =<< runQueryParams roundtrip_array (Only people)
        out2 <- withConnection connectionString $
          firstRow =<< runQuery oneway
        out2_array <- withConnection connectionString $
          firstRow =<< runQuery oneway_array
        unsafe_array <- withConnection connectionString $
          firstRow =<< runQuery unsafeQ
        nothings <- withConnection connectionString $
          firstRow =<< runQuery nothingQ
  
        out `shouldBe` Just (Only adam)
        out_inline `shouldBe` Just (Only adam)
        out_array `shouldBe` Just (Only people)
        out2 `shouldBe` Just (Only adam)
        out2_array `shouldBe` Just (Only people)
        unsafe_array `shouldBe` Just (Only (VarArray [Composite adam]))
        nothings `shouldBe` Just (Only (Person Nothing Nothing))
  
    describe "cmdStatus and cmdTuples" $ do
  
      let
        statusAndTuples stmnt = withConnection connectionString $ do
          result <- execute stmnt
          status <- cmdStatus result
          tuples <- cmdTuples result
          return (status, tuples)
  
      it "should tell you about the command and the number of rows effected" $ do
  
        (status1, tuples1) <- statusAndTuples (insertUsers "Jonah" ["Isaiah"])
        status1 `shouldBe` "INSERT 0 2"
        tuples1 `shouldBe` Just 2
  
        (status2, tuples2) <- statusAndTuples (deleteUser "Noah")
        status2 `shouldBe` "DELETE 0"
        tuples2 `shouldBe` Just 0
  
        (status3, tuples3) <- statusAndTuples (deleteUser "Jonah")
        status3 `shouldBe` "DELETE 1"
        tuples3 `shouldBe` Just 1
  
        (status4, tuples4) <- statusAndTuples silent
        status4 `shouldBe` "SET"
        tuples4 `shouldBe` Nothing
  