{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module SumTypeTest (specsWith, sumTypeMigrate) where

import qualified Data.Text as T

import Database.Persist.TH
import Init

share [mkPersist persistSettings { mpsGeneric = True }, mkMigrate "sumTypeMigrate"] [persistLowerCase|
Bicycle
    brand T.Text
Car
    make T.Text
    model T.Text
+Vehicle
    bicycle BicycleId
    car CarId
|]

-- This is needed for mpsGeneric = True
-- The typical persistent user sets mpsGeneric = False
-- https://ghc.haskell.org/trac/ghc/ticket/8100
deriving instance Show (BackendKey backend) => Show (VehicleGeneric backend)
deriving instance Eq (BackendKey backend) => Eq (VehicleGeneric backend)

specsWith
    ::
    ( PersistQueryWrite backend
    , BaseBackend backend ~ backend
    , MonadIO m, MonadFail m
    )
    => RunDb backend m
    -> Maybe (ReaderT backend m a)
    -- ^ Optional migrations for SQL backends
    -> Spec
specsWith :: RunDb backend m -> Maybe (ReaderT backend m a) -> Spec
specsWith RunDb backend m
runDb Maybe (ReaderT backend m a)
mmigrate = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"sum types" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"works" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
asIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RunDb backend m
runDb RunDb backend m -> RunDb backend m
forall a b. (a -> b) -> a -> b
$ do
        Maybe (ReaderT backend m a) -> ReaderT backend m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ Maybe (ReaderT backend m a)
mmigrate
        Key (CarGeneric backend)
car1 <- CarGeneric backend -> ReaderT backend m (Key (CarGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert (CarGeneric backend
 -> ReaderT backend m (Key (CarGeneric backend)))
-> CarGeneric backend
-> ReaderT backend m (Key (CarGeneric backend))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CarGeneric backend
forall backend. Text -> Text -> CarGeneric backend
Car Text
"Ford" Text
"Thunderbird"
        Key (CarGeneric backend)
car2 <- CarGeneric backend -> ReaderT backend m (Key (CarGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert (CarGeneric backend
 -> ReaderT backend m (Key (CarGeneric backend)))
-> CarGeneric backend
-> ReaderT backend m (Key (CarGeneric backend))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CarGeneric backend
forall backend. Text -> Text -> CarGeneric backend
Car Text
"Kia" Text
"Rio"
        Key (BicycleGeneric backend)
bike1 <- BicycleGeneric backend
-> ReaderT backend m (Key (BicycleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert (BicycleGeneric backend
 -> ReaderT backend m (Key (BicycleGeneric backend)))
-> BicycleGeneric backend
-> ReaderT backend m (Key (BicycleGeneric backend))
forall a b. (a -> b) -> a -> b
$ Text -> BicycleGeneric backend
forall backend. Text -> BicycleGeneric backend
Bicycle Text
"Shwinn"

        Key (VehicleGeneric backend)
vc1 <- VehicleGeneric backend
-> ReaderT backend m (Key (VehicleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert (VehicleGeneric backend
 -> ReaderT backend m (Key (VehicleGeneric backend)))
-> VehicleGeneric backend
-> ReaderT backend m (Key (VehicleGeneric backend))
forall a b. (a -> b) -> a -> b
$ Key (CarGeneric backend) -> VehicleGeneric backend
forall backend. Key (CarGeneric backend) -> VehicleGeneric backend
VehicleCarSum Key (CarGeneric backend)
car1
        Key (VehicleGeneric backend)
vc2 <- VehicleGeneric backend
-> ReaderT backend m (Key (VehicleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert (VehicleGeneric backend
 -> ReaderT backend m (Key (VehicleGeneric backend)))
-> VehicleGeneric backend
-> ReaderT backend m (Key (VehicleGeneric backend))
forall a b. (a -> b) -> a -> b
$ Key (CarGeneric backend) -> VehicleGeneric backend
forall backend. Key (CarGeneric backend) -> VehicleGeneric backend
VehicleCarSum Key (CarGeneric backend)
car2
        Key (VehicleGeneric backend)
vb1 <- VehicleGeneric backend
-> ReaderT backend m (Key (VehicleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert (VehicleGeneric backend
 -> ReaderT backend m (Key (VehicleGeneric backend)))
-> VehicleGeneric backend
-> ReaderT backend m (Key (VehicleGeneric backend))
forall a b. (a -> b) -> a -> b
$ Key (BicycleGeneric backend) -> VehicleGeneric backend
forall backend.
Key (BicycleGeneric backend) -> VehicleGeneric backend
VehicleBicycleSum Key (BicycleGeneric backend)
bike1

        Maybe (VehicleGeneric backend)
x1 <- Key (VehicleGeneric backend)
-> ReaderT backend m (Maybe (VehicleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (VehicleGeneric backend)
vc1
        IO () -> ReaderT backend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT backend m ()) -> IO () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Maybe (VehicleGeneric backend)
x1 Maybe (VehicleGeneric backend)
-> Maybe (VehicleGeneric backend) -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= VehicleGeneric backend -> Maybe (VehicleGeneric backend)
forall a. a -> Maybe a
Just (Key (CarGeneric backend) -> VehicleGeneric backend
forall backend. Key (CarGeneric backend) -> VehicleGeneric backend
VehicleCarSum Key (CarGeneric backend)
car1)

        Maybe (VehicleGeneric backend)
x2 <- Key (VehicleGeneric backend)
-> ReaderT backend m (Maybe (VehicleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (VehicleGeneric backend)
vc2
        IO () -> ReaderT backend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT backend m ()) -> IO () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Maybe (VehicleGeneric backend)
x2 Maybe (VehicleGeneric backend)
-> Maybe (VehicleGeneric backend) -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= VehicleGeneric backend -> Maybe (VehicleGeneric backend)
forall a. a -> Maybe a
Just (Key (CarGeneric backend) -> VehicleGeneric backend
forall backend. Key (CarGeneric backend) -> VehicleGeneric backend
VehicleCarSum Key (CarGeneric backend)
car2)

        Maybe (VehicleGeneric backend)
x3 <- Key (VehicleGeneric backend)
-> ReaderT backend m (Maybe (VehicleGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (VehicleGeneric backend)
vb1
        IO () -> ReaderT backend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT backend m ()) -> IO () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Maybe (VehicleGeneric backend)
x3 Maybe (VehicleGeneric backend)
-> Maybe (VehicleGeneric backend) -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= VehicleGeneric backend -> Maybe (VehicleGeneric backend)
forall a. a -> Maybe a
Just (Key (BicycleGeneric backend) -> VehicleGeneric backend
forall backend.
Key (BicycleGeneric backend) -> VehicleGeneric backend
VehicleBicycleSum Key (BicycleGeneric backend)
bike1)