{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module EmbedOrderTest (specsWith, embedOrderMigrate, cleanDB) where

import qualified Data.Map as Map
import Debug.Trace (trace)

import Init

debug :: Show s => s -> s
debug :: s -> s
debug s
x = String -> s -> s
forall a. String -> a -> a
trace (s -> String
forall a. Show a => a -> String
show s
x) s
x

share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "embedOrderMigrate"] [persistUpperCase|
Foo sql=foo_embed_order
    bars [Bar]
    deriving Eq Show
Bar sql=bar_embed_order
    b String
    u String
    g String
    deriving Eq Show
|]

cleanDB :: Runner backend m => ReaderT backend m ()
cleanDB :: ReaderT backend m ()
cleanDB = do
  [Filter (FooGeneric backend)] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (FooGeneric backend)])
  [Filter (BarGeneric backend)] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (BarGeneric backend)])

specsWith :: Runner backend m => RunDb backend m -> Spec
specsWith :: RunDb backend m -> Spec
specsWith RunDb backend m
db = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"embedded entities" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"preserves ordering" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb backend m
db RunDb backend m -> RunDb backend m
forall a b. (a -> b) -> a -> b
$ do
        let foo :: FooGeneric backend
foo = [Bar] -> FooGeneric backend
forall backend. [Bar] -> FooGeneric backend
Foo [String -> String -> String -> Bar
forall backend. String -> String -> String -> BarGeneric backend
Bar String
"b" String
"u" String
"g"]
        Key (FooGeneric backend)
fooId <- FooGeneric backend -> ReaderT backend m (Key (FooGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert FooGeneric backend
forall backend. FooGeneric backend
foo
        Just FooGeneric backend
otherFoo <- Key (FooGeneric backend)
-> ReaderT backend m (Maybe (FooGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (FooGeneric backend)
fooId
        FooGeneric backend
forall backend. FooGeneric backend
foo FooGeneric backend -> FooGeneric backend -> ReaderT backend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== FooGeneric backend
otherFoo

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"PersistMap PersistValue serializaion" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb backend m
db RunDb backend m -> RunDb backend m
forall a b. (a -> b) -> a -> b
$ do
        let record :: Map Text Text
record = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"b" :: Text,Text
"b" :: Text),(Text
"u",Text
"u"),(Text
"g",Text
"g")]
        Map Text Text
record Map Text Text -> Map Text Text -> ReaderT backend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== (Either Text (Map Text Text) -> Map Text Text
forall a b. Show a => Either a b -> b
fromRight (Either Text (Map Text Text) -> Map Text Text)
-> (Map Text Text -> Either Text (Map Text Text))
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text (Map Text Text)
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text (Map Text Text))
-> (Map Text Text -> PersistValue)
-> Map Text Text
-> Either Text (Map Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue) Map Text Text
record

fromRight :: Show a => Either a b -> b
fromRight :: Either a b -> b
fromRight (Left a
e) = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"expected Right, got Left " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e
fromRight (Right b
x) = b
x