{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Syd.Validity.Persist
( persistSpecOnValid,
persistSpec,
persistSpecOnArbitrary,
persistSpecOnGen,
fromPersistValueAndToPersistValueAreInversesOnGen,
)
where
import Data.GenValidity
import qualified Data.Text as T
import Data.Typeable
import Database.Persist (PersistField (..))
import Test.QuickCheck
import Test.Syd
import Test.Syd.Validity.Utils
persistSpecOnValid ::
forall a.
(Show a, Eq a, Typeable a, GenValid a, PersistField a) =>
Spec
persistSpecOnValid :: Spec
persistSpecOnValid = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, PersistField a) =>
Gen a -> String -> (a -> [a]) -> Spec
persistSpecOnGen (GenValid a => Gen a
forall a. GenValid a => Gen a
genValid @a) String
"valid" a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
persistSpec ::
forall a.
(Show a, Eq a, Typeable a, GenUnchecked a, PersistField a) =>
Spec
persistSpec :: Spec
persistSpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, PersistField a) =>
Gen a -> String -> (a -> [a]) -> Spec
persistSpecOnGen (GenUnchecked a => Gen a
forall a. GenUnchecked a => Gen a
genUnchecked @a) String
"unchecked" a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked
persistSpecOnArbitrary ::
forall a.
(Show a, Eq a, Typeable a, Arbitrary a, PersistField a) =>
Spec
persistSpecOnArbitrary :: Spec
persistSpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, PersistField a) =>
Gen a -> String -> (a -> [a]) -> Spec
persistSpecOnGen (Arbitrary a => Gen a
forall a. Arbitrary a => Gen a
arbitrary @a) String
"arbitrary" a -> [a]
forall a. Arbitrary a => a -> [a]
shrink
persistSpecOnGen ::
forall a.
(Show a, Eq a, Typeable a, PersistField a) =>
Gen a ->
String ->
(a -> [a]) ->
Spec
persistSpecOnGen :: Gen a -> String -> (a -> [a]) -> Spec
persistSpecOnGen Gen a
gen String
genname a -> [a]
s =
Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
let name :: String
name = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"PersistField " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"fromPersistValue :: PersistValue -> Either Text " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
( [String] -> String
unwords
[ String
"ensures that toPersistValue and fromPersistValue are inverses for",
String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname,
String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'s"
]
)
(Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ Gen a -> (a -> [a]) -> Property
forall a.
(Show a, Eq a, PersistField a) =>
Gen a -> (a -> [a]) -> Property
fromPersistValueAndToPersistValueAreInversesOnGen Gen a
gen a -> [a]
s
fromPersistValueAndToPersistValueAreInversesOnGen ::
(Show a, Eq a, PersistField a) => Gen a -> (a -> [a]) -> Property
fromPersistValueAndToPersistValueAreInversesOnGen :: Gen a -> (a -> [a]) -> Property
fromPersistValueAndToPersistValueAreInversesOnGen Gen a
gen a -> [a]
s =
Gen a -> (a -> [a]) -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
let encoded :: PersistValue
encoded = a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue a
a
errOrDecoded :: Either Text a
errOrDecoded = PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
encoded
in case Either Text a
errOrDecoded of
Left Text
err ->
String -> IO ()
forall a. HasCallStack => String -> IO a
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines
[ String
"Decoding failed with error",
Text -> String
T.unpack Text
err,
String
"instead of decoding to",
a -> String
forall a. Show a => a -> String
show a
a,
String
"'encode' encoded it to the persist",
PersistValue -> String
forall a. Show a => a -> String
show PersistValue
encoded
]
Right a
decoded ->
let ctx :: String
ctx =
[String] -> String
unlines
[ String
"Decoding succeeded, but the decoded value",
a -> String
forall a. Show a => a -> String
show a
decoded,
String
"differs from expected decoded value",
a -> String
forall a. Show a => a -> String
show a
a,
String
"'encode' encoded it to the persist",
PersistValue -> String
forall a. Show a => a -> String
show PersistValue
encoded
]
in String -> IO () -> IO ()
forall a. String -> IO a -> IO a
context String
ctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ a
decoded a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
a