{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module MaxLenTest (specsWith, maxlenMigrate) where

import Data.String (IsString)

import Init

share [mkPersist sqlSettings { mpsGeneric = True },  mkMigrate "maxlenMigrate"] [persistLowerCase|
  MaxLen
    text1 Text
    text2 Text maxlen=3
    bs1 ByteString
    bs2 ByteString maxlen=3
    str1 String
    str2 String maxlen=3
    MLText1 text1
    MLText2 text2
    MLBs1 bs1
    MLBs2 bs2
    MLStr1 str1
    MLStr2 str2
    deriving Show Eq
|]

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
"Maximum length attribute" (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
"truncates values that are too long" (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 t1 :: MaxLenGeneric backend
t1  = Text
-> Text
-> ByteString
-> ByteString
-> String
-> String
-> MaxLenGeneric backend
forall backend.
Text
-> Text
-> ByteString
-> ByteString
-> String
-> String
-> MaxLenGeneric backend
MaxLen Text
forall t. IsString t => t
a Text
forall t. IsString t => t
a  ByteString
forall t. IsString t => t
a ByteString
forall t. IsString t => t
a  String
forall t. IsString t => t
a String
forall t. IsString t => t
a
        t2 :: MaxLenGeneric backend
t2  = Text
-> Text
-> ByteString
-> ByteString
-> String
-> String
-> MaxLenGeneric backend
forall backend.
Text
-> Text
-> ByteString
-> ByteString
-> String
-> String
-> MaxLenGeneric backend
MaxLen Text
forall t. IsString t => t
b Text
forall t. IsString t => t
b  ByteString
forall t. IsString t => t
b ByteString
forall t. IsString t => t
b  String
forall t. IsString t => t
b String
forall t. IsString t => t
b
        t2' :: MaxLenGeneric backend
t2' = Text
-> Text
-> ByteString
-> ByteString
-> String
-> String
-> MaxLenGeneric backend
forall backend.
Text
-> Text
-> ByteString
-> ByteString
-> String
-> String
-> MaxLenGeneric backend
MaxLen Text
forall t. IsString t => t
b Text
forall t. IsString t => t
b' ByteString
forall t. IsString t => t
b ByteString
forall t. IsString t => t
b' String
forall t. IsString t => t
b String
forall t. IsString t => t
b'
        a, b, b' :: IsString t => t
        a :: t
a  = t
"a"
        b :: t
b  = t
"12345"
        b' :: t
b' = t
"123"
    Key (MaxLenGeneric backend)
t1k <- MaxLenGeneric backend
-> ReaderT backend m (Key (MaxLenGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert MaxLenGeneric backend
forall backend. MaxLenGeneric backend
t1
    Key (MaxLenGeneric backend)
t2k <- MaxLenGeneric backend
-> ReaderT backend m (Key (MaxLenGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert MaxLenGeneric backend
forall backend. MaxLenGeneric backend
t2
    Just MaxLenGeneric backend
t1v <- Key (MaxLenGeneric backend)
-> ReaderT backend m (Maybe (MaxLenGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (MaxLenGeneric backend)
t1k
    Just MaxLenGeneric backend
t2v <- Key (MaxLenGeneric backend)
-> ReaderT backend m (Maybe (MaxLenGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (MaxLenGeneric backend)
t2k
    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
$ do MaxLenGeneric backend
t1v MaxLenGeneric backend -> MaxLenGeneric backend -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= MaxLenGeneric backend
forall backend. MaxLenGeneric backend
t1
                if MaxLenGeneric backend
t2v MaxLenGeneric backend -> MaxLenGeneric backend -> Bool
forall a. Eq a => a -> a -> Bool
== MaxLenGeneric backend
forall backend. MaxLenGeneric backend
t2
                  then MaxLenGeneric backend
t2v MaxLenGeneric backend -> MaxLenGeneric backend -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= MaxLenGeneric backend
forall backend. MaxLenGeneric backend
t2 -- FIXME: why u no truncate?
                  else MaxLenGeneric backend
t2v MaxLenGeneric backend -> MaxLenGeneric backend -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= MaxLenGeneric backend
forall backend. MaxLenGeneric backend
t2'