{-# 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