{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Recursive (specsWith, recursiveMigrate, cleanup) where

import Init

share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "recursiveMigrate"] [persistLowerCase|
SubType
  object [MenuObject]
  deriving Show Eq
MenuObject
  sub SubType Maybe
  deriving Show Eq
|]

cleanup
    :: (PersistStoreWrite (BaseBackend backend), PersistQueryWrite backend)
    => ReaderT backend IO ()
cleanup :: ReaderT backend IO ()
cleanup = do
  [Filter (MenuObjectGeneric (BaseBackend backend))]
-> ReaderT backend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (MenuObjectGeneric backend)])
  [Filter (SubTypeGeneric (BaseBackend backend))]
-> ReaderT backend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (SubTypeGeneric backend)])

specsWith
    ::
    ( PersistStoreWrite backend
    , PersistStoreWrite (BaseBackend backend)
    , MonadIO m
    )
    => RunDb backend m
    -> Spec
specsWith :: RunDb backend m -> Spec
specsWith RunDb backend m
runDb = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"recursive definitions" (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
"mutually recursive" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (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
    let m1 :: MenuObjectGeneric backend
m1 = Maybe SubType -> MenuObjectGeneric backend
forall backend. Maybe SubType -> MenuObjectGeneric backend
MenuObject (Maybe SubType -> MenuObjectGeneric backend)
-> Maybe SubType -> MenuObjectGeneric backend
forall a b. (a -> b) -> a -> b
$ SubType -> Maybe SubType
forall a. a -> Maybe a
Just (SubType -> Maybe SubType) -> SubType -> Maybe SubType
forall a b. (a -> b) -> a -> b
$ [MenuObject] -> SubType
forall backend. [MenuObject] -> SubTypeGeneric backend
SubType []
    let m2 :: MenuObjectGeneric backend
m2 = Maybe SubType -> MenuObjectGeneric backend
forall backend. Maybe SubType -> MenuObjectGeneric backend
MenuObject (Maybe SubType -> MenuObjectGeneric backend)
-> Maybe SubType -> MenuObjectGeneric backend
forall a b. (a -> b) -> a -> b
$ SubType -> Maybe SubType
forall a. a -> Maybe a
Just (SubType -> Maybe SubType) -> SubType -> Maybe SubType
forall a b. (a -> b) -> a -> b
$ [MenuObject] -> SubType
forall backend. [MenuObject] -> SubTypeGeneric backend
SubType [MenuObject
forall backend. MenuObjectGeneric backend
m1]
    let m3 :: MenuObjectGeneric backend
m3 = Maybe SubType -> MenuObjectGeneric backend
forall backend. Maybe SubType -> MenuObjectGeneric backend
MenuObject (Maybe SubType -> MenuObjectGeneric backend)
-> Maybe SubType -> MenuObjectGeneric backend
forall a b. (a -> b) -> a -> b
$ SubType -> Maybe SubType
forall a. a -> Maybe a
Just (SubType -> Maybe SubType) -> SubType -> Maybe SubType
forall a b. (a -> b) -> a -> b
$ [MenuObject] -> SubType
forall backend. [MenuObject] -> SubTypeGeneric backend
SubType [MenuObject
forall backend. MenuObjectGeneric backend
m2]
    Key (MenuObjectGeneric (BaseBackend backend))
k3 <- MenuObjectGeneric (BaseBackend backend)
-> ReaderT
     backend m (Key (MenuObjectGeneric (BaseBackend backend)))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert MenuObjectGeneric (BaseBackend backend)
forall backend. MenuObjectGeneric backend
m3
    Maybe (MenuObjectGeneric (BaseBackend backend))
m3' <- Key (MenuObjectGeneric (BaseBackend backend))
-> ReaderT
     backend m (Maybe (MenuObjectGeneric (BaseBackend backend)))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (MenuObjectGeneric (BaseBackend backend))
k3
    Maybe (MenuObjectGeneric (BaseBackend backend))
m3' Maybe (MenuObjectGeneric (BaseBackend backend))
-> Maybe (MenuObjectGeneric (BaseBackend backend))
-> ReaderT backend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== MenuObjectGeneric (BaseBackend backend)
-> Maybe (MenuObjectGeneric (BaseBackend backend))
forall a. a -> Maybe a
Just MenuObjectGeneric (BaseBackend backend)
forall backend. MenuObjectGeneric backend
m3