ArrayAggTest.hs 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354
  1. {-# LANGUAGE ExistentialQuantification #-}
  2. {-# LANGUAGE FlexibleContexts #-}
  3. {-# LANGUAGE FlexibleInstances #-}
  4. {-# LANGUAGE MultiParamTypeClasses #-}
  5. {-# LANGUAGE OverloadedStrings #-}
  6. {-# LANGUAGE QuasiQuotes #-}
  7. {-# LANGUAGE TemplateHaskell #-}
  8. {-# LANGUAGE TypeFamilies #-}
  9. {-# LANGUAGE UndecidableInstances #-} -- FIXME
  10. module ArrayAggTest where
  11. import Control.Monad.IO.Class (MonadIO)
  12. import Data.Aeson
  13. import Data.List (sort)
  14. import qualified Data.Text as T
  15. import Test.Hspec.Expectations ()
  16. import PersistentTestModels
  17. import PgInit
  18. share [mkPersist persistSettings, mkMigrate "jsonTestMigrate"] [persistLowerCase|
  19. TestValue
  20. json Value
  21. |]
  22. cleanDB :: (BaseBackend backend ~ SqlBackend, PersistQueryWrite backend, MonadIO m) => ReaderT backend m ()
  23. cleanDB = deleteWhere ([] :: [Filter TestValue])
  24. emptyArr :: Value
  25. emptyArr = toJSON ([] :: [Value])
  26. specs :: RunDb SqlBackend IO -> Spec
  27. specs runDb = do
  28. describe "rawSql/array_agg" $ do
  29. let runArrayAggTest :: (PersistField [a], Ord a, Show a) => Text -> [a] -> Assertion
  30. runArrayAggTest dbField expected = runDb $ do
  31. void $ insertMany
  32. [ UserPT "a" $ Just "b"
  33. , UserPT "c" $ Just "d"
  34. , UserPT "e" Nothing
  35. , UserPT "g" $ Just "h" ]
  36. escape <- ((. DBName) . connEscapeName) `fmap` ask
  37. let query = T.concat [ "SELECT array_agg(", escape dbField, ") "
  38. , "FROM ", escape "UserPT"
  39. ]
  40. [Single xs] <- rawSql query []
  41. liftIO $ sort xs @?= expected
  42. it "works for [Text]" $ do
  43. runArrayAggTest "ident" ["a", "c", "e", "g" :: Text]
  44. it "works for [Maybe Text]" $ do
  45. runArrayAggTest "password" [Nothing, Just "b", Just "d", Just "h" :: Maybe Text]