module Integration.Sharing.Decoders.DomainSpec (spec) where import Hasql.Connection qualified as Connection import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders import Hasql.Session qualified as Session import Hasql.Statement qualified as Statement import Helpers.Scripts qualified as Scripts import Prelude import Test.Hspec spec :: SpecWith Scripts.ScopeParams spec = do describe "Domain type decoding" do describe "Simple scalar domains" do it "decodes a domain based on int8 using int8 codec" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as int8"]) mempty Decoders.noResult -- Test decoding from static value Session.statement () $ Statement.preparable (mconcat ["select 42 :: ", domainName]) mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8))) result `shouldBe` Right (42 :: Int64) it "decodes a domain based on text using text codec" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as text"]) mempty Decoders.noResult -- Test decoding from static value Session.statement () $ Statement.preparable (mconcat ["select 'hello' :: ", domainName]) mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text))) result `shouldBe` Right "hello" it "decodes a domain based on bool using bool codec" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as bool"]) mempty Decoders.noResult -- Test decoding from static value Session.statement () $ Statement.preparable (mconcat ["select true :: ", domainName]) mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool))) result `shouldBe` Right True it "roundtrips a domain based on numeric" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as numeric"]) mempty Decoders.noResult -- Test roundtrip Session.statement (123.456 :: Scientific) $ Statement.preparable (mconcat ["select $1 :: ", domainName]) (Encoders.param (Encoders.nonNullable Encoders.numeric)) (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.numeric))) result `shouldBe` Right (123.456 :: Scientific) describe "Domain with constraints" do it "decodes domain values that satisfy constraints" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type with constraint Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as int8 check (value > 0)"]) mempty Decoders.noResult -- Decode value that satisfies constraint Session.statement () $ Statement.preparable (mconcat ["select 42 :: ", domainName]) mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8))) result `shouldBe` Right (42 :: Int64) describe "Domain type cast compatibility for composite usage" do it "decodes domain value cast to base type from composite field" \config -> do domainName <- Scripts.generateSymname compositeName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as int8"]) mempty Decoders.noResult -- Create composite type with domain field Session.statement () $ Statement.preparable (mconcat ["create type ", compositeName, " as (x ", domainName, ", y bool)"]) mempty Decoders.noResult -- Extract and cast domain field to base type for decoding Session.statement () $ Statement.preparable (mconcat ["select ((42 :: ", domainName, ") :: int8)"]) mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8))) result `shouldBe` Right (42 :: Int64) describe "Domain type cast compatibility for array usage" do it "decodes array cast from domain array to base type array" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as int8"]) mempty Decoders.noResult -- Decode base type array Session.statement () $ Statement.preparable "select ARRAY[1,2,3] :: int8[]" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.int8))))) result `shouldBe` Right ([1, 2, 3] :: [Int64]) it "roundtrips array using base type codec" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as text"]) mempty Decoders.noResult -- Test roundtrip using base type codec Session.statement (["a", "b", "c"] :: [Text]) $ Statement.preparable "select $1 :: text[]" ( Encoders.param ( Encoders.nonNullable (Encoders.foldableArray (Encoders.nonNullable Encoders.text)) ) ) (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.text))))) result `shouldBe` Right (["a", "b", "c"] :: [Text]) it "decodes base type array that can work with domain arrays via cast" \config -> do domainName <- Scripts.generateSymname Scripts.onPreparableConnection config \connection -> do result <- Connection.use connection do -- Create domain type Session.statement () $ Statement.preparable (mconcat ["create domain ", domainName, " as int8"]) mempty Decoders.noResult -- Demonstrate that base codec works for arrays Session.statement ([10, 20, 30] :: [Int64]) $ Statement.preparable "select $1 :: int8[]" ( Encoders.param ( Encoders.nonNullable (Encoders.foldableArray (Encoders.nonNullable Encoders.int8)) ) ) (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.int8))))) result `shouldBe` Right ([10, 20, 30] :: [Int64])