{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module TypeLitFieldDefsTest (specsWith, typeLitFieldDefsMigrate) where import Data.Maybe (fromJust) import GHC.TypeLits import Init newtype Finite (n :: Nat) = Finite Int deriving (Int -> Finite n -> ShowS [Finite n] -> ShowS Finite n -> String (Int -> Finite n -> ShowS) -> (Finite n -> String) -> ([Finite n] -> ShowS) -> Show (Finite n) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall (n :: Nat). Int -> Finite n -> ShowS forall (n :: Nat). [Finite n] -> ShowS forall (n :: Nat). Finite n -> String showList :: [Finite n] -> ShowS $cshowList :: forall (n :: Nat). [Finite n] -> ShowS show :: Finite n -> String $cshow :: forall (n :: Nat). Finite n -> String showsPrec :: Int -> Finite n -> ShowS $cshowsPrec :: forall (n :: Nat). Int -> Finite n -> ShowS Show, Finite n -> Finite n -> Bool (Finite n -> Finite n -> Bool) -> (Finite n -> Finite n -> Bool) -> Eq (Finite n) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (n :: Nat). Finite n -> Finite n -> Bool /= :: Finite n -> Finite n -> Bool $c/= :: forall (n :: Nat). Finite n -> Finite n -> Bool == :: Finite n -> Finite n -> Bool $c== :: forall (n :: Nat). Finite n -> Finite n -> Bool Eq) instance PersistField (Finite n) where toPersistValue :: Finite n -> PersistValue toPersistValue (Finite Int n) = Int -> PersistValue forall a. PersistField a => a -> PersistValue toPersistValue Int n fromPersistValue :: PersistValue -> Either Text (Finite n) fromPersistValue = (Int -> Finite n) -> Either Text Int -> Either Text (Finite n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Int -> Finite n forall (n :: Nat). Int -> Finite n Finite (Either Text Int -> Either Text (Finite n)) -> (PersistValue -> Either Text Int) -> PersistValue -> Either Text (Finite n) forall b c a. (b -> c) -> (a -> b) -> a -> c . PersistValue -> Either Text Int forall a. PersistField a => PersistValue -> Either Text a fromPersistValue instance PersistFieldSql (Finite n) where sqlType :: Proxy (Finite n) -> SqlType sqlType Proxy (Finite n) _ = Proxy Int -> SqlType forall a. PersistFieldSql a => Proxy a -> SqlType sqlType (Proxy Int forall k (t :: k). Proxy t Proxy :: Proxy Int) newtype Labelled (t :: Symbol) = Labelled Int deriving (Int -> Labelled t -> ShowS [Labelled t] -> ShowS Labelled t -> String (Int -> Labelled t -> ShowS) -> (Labelled t -> String) -> ([Labelled t] -> ShowS) -> Show (Labelled t) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall (t :: Symbol). Int -> Labelled t -> ShowS forall (t :: Symbol). [Labelled t] -> ShowS forall (t :: Symbol). Labelled t -> String showList :: [Labelled t] -> ShowS $cshowList :: forall (t :: Symbol). [Labelled t] -> ShowS show :: Labelled t -> String $cshow :: forall (t :: Symbol). Labelled t -> String showsPrec :: Int -> Labelled t -> ShowS $cshowsPrec :: forall (t :: Symbol). Int -> Labelled t -> ShowS Show, Labelled t -> Labelled t -> Bool (Labelled t -> Labelled t -> Bool) -> (Labelled t -> Labelled t -> Bool) -> Eq (Labelled t) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (t :: Symbol). Labelled t -> Labelled t -> Bool /= :: Labelled t -> Labelled t -> Bool $c/= :: forall (t :: Symbol). Labelled t -> Labelled t -> Bool == :: Labelled t -> Labelled t -> Bool $c== :: forall (t :: Symbol). Labelled t -> Labelled t -> Bool Eq) instance PersistField (Labelled n) where toPersistValue :: Labelled n -> PersistValue toPersistValue (Labelled Int n) = Int -> PersistValue forall a. PersistField a => a -> PersistValue toPersistValue Int n fromPersistValue :: PersistValue -> Either Text (Labelled n) fromPersistValue = (Int -> Labelled n) -> Either Text Int -> Either Text (Labelled n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Int -> Labelled n forall (t :: Symbol). Int -> Labelled t Labelled (Either Text Int -> Either Text (Labelled n)) -> (PersistValue -> Either Text Int) -> PersistValue -> Either Text (Labelled n) forall b c a. (b -> c) -> (a -> b) -> a -> c . PersistValue -> Either Text Int forall a. PersistField a => PersistValue -> Either Text a fromPersistValue instance PersistFieldSql (Labelled n) where sqlType :: Proxy (Labelled n) -> SqlType sqlType Proxy (Labelled n) _ = Proxy Int -> SqlType forall a. PersistFieldSql a => Proxy a -> SqlType sqlType (Proxy Int forall k (t :: k). Proxy t Proxy :: Proxy Int) share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "typeLitFieldDefsMigrate"] [persistLowerCase| TypeLitFieldDefsNumeric one (Finite 1) twenty (Finite 20) deriving Eq Show TypeLitFieldDefsLabelled one (Labelled "one") twenty (Labelled "twenty") deriving Eq Show |] one :: Finite 1 one :: Finite 1 one = Int -> Finite 1 forall (n :: Nat). Int -> Finite n Finite Int 1 oneLabelled :: Labelled "one" oneLabelled :: Labelled "one" oneLabelled = Int -> Labelled "one" forall (t :: Symbol). Int -> Labelled t Labelled Int 1 twenty :: Finite 20 twenty :: Finite 20 twenty = Int -> Finite 20 forall (n :: Nat). Int -> Finite n Finite Int 20 twentyLabelled :: Labelled "twenty" twentyLabelled :: Labelled "twenty" twentyLabelled = Int -> Labelled "twenty" forall (t :: Symbol). Int -> Labelled t Labelled Int 20 specsWith :: Runner backend 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 "Type Lit Field 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 "runs appropriate migrations" (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 Key (TypeLitFieldDefsNumericGeneric backend) numKey <- TypeLitFieldDefsNumericGeneric backend -> ReaderT backend m (Key (TypeLitFieldDefsNumericGeneric backend)) forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) insert (TypeLitFieldDefsNumericGeneric backend -> ReaderT backend m (Key (TypeLitFieldDefsNumericGeneric backend))) -> TypeLitFieldDefsNumericGeneric backend -> ReaderT backend m (Key (TypeLitFieldDefsNumericGeneric backend)) forall a b. (a -> b) -> a -> b $ Finite 1 -> Finite 20 -> TypeLitFieldDefsNumericGeneric backend forall backend. Finite 1 -> Finite 20 -> TypeLitFieldDefsNumericGeneric backend TypeLitFieldDefsNumeric Finite 1 one Finite 20 twenty TypeLitFieldDefsNumericGeneric backend num <- Key (TypeLitFieldDefsNumericGeneric backend) -> ReaderT backend m (TypeLitFieldDefsNumericGeneric backend) forall record backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend record backend, MonadIO m) => Key record -> ReaderT backend m record getJust Key (TypeLitFieldDefsNumericGeneric backend) numKey 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 $ TypeLitFieldDefsNumericGeneric backend -> Finite 1 forall backend. TypeLitFieldDefsNumericGeneric backend -> Finite 1 typeLitFieldDefsNumericOne TypeLitFieldDefsNumericGeneric backend num Finite 1 -> Finite 1 -> IO () forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO () @?= Finite 1 one 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 $ TypeLitFieldDefsNumericGeneric backend -> Finite 20 forall backend. TypeLitFieldDefsNumericGeneric backend -> Finite 20 typeLitFieldDefsNumericTwenty TypeLitFieldDefsNumericGeneric backend num Finite 20 -> Finite 20 -> IO () forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO () @?= Finite 20 twenty Key (TypeLitFieldDefsLabelledGeneric backend) labelledKey <- TypeLitFieldDefsLabelledGeneric backend -> ReaderT backend m (Key (TypeLitFieldDefsLabelledGeneric backend)) forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) insert (TypeLitFieldDefsLabelledGeneric backend -> ReaderT backend m (Key (TypeLitFieldDefsLabelledGeneric backend))) -> TypeLitFieldDefsLabelledGeneric backend -> ReaderT backend m (Key (TypeLitFieldDefsLabelledGeneric backend)) forall a b. (a -> b) -> a -> b $ Labelled "one" -> Labelled "twenty" -> TypeLitFieldDefsLabelledGeneric backend forall backend. Labelled "one" -> Labelled "twenty" -> TypeLitFieldDefsLabelledGeneric backend TypeLitFieldDefsLabelled Labelled "one" oneLabelled Labelled "twenty" twentyLabelled TypeLitFieldDefsLabelledGeneric backend lbl <- Key (TypeLitFieldDefsLabelledGeneric backend) -> ReaderT backend m (TypeLitFieldDefsLabelledGeneric backend) forall record backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend record backend, MonadIO m) => Key record -> ReaderT backend m record getJust Key (TypeLitFieldDefsLabelledGeneric backend) labelledKey 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 $ TypeLitFieldDefsLabelledGeneric backend -> Labelled "one" forall backend. TypeLitFieldDefsLabelledGeneric backend -> Labelled "one" typeLitFieldDefsLabelledOne TypeLitFieldDefsLabelledGeneric backend lbl Labelled "one" -> Labelled "one" -> IO () forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO () @?= Labelled "one" oneLabelled 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 $ TypeLitFieldDefsLabelledGeneric backend -> Labelled "twenty" forall backend. TypeLitFieldDefsLabelledGeneric backend -> Labelled "twenty" typeLitFieldDefsLabelledTwenty TypeLitFieldDefsLabelledGeneric backend lbl Labelled "twenty" -> Labelled "twenty" -> IO () forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO () @?= Labelled "twenty" twentyLabelled