{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Init (
(@/=), (@==), (==@)
, asIO
, assertNotEqual
, assertNotEmpty
, assertEmpty
, isTravis
, module Database.Persist.Sql
, persistSettings
, MkPersistSettings (..)
, BackendKey(..)
, GenerateKey(..)
, RunDb
, Runner
, module Database.Persist
, module Test.Hspec
, module Test.HUnit
, mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase
, Int32, Int64
, Text
, module Control.Monad.Reader
, module Control.Monad
, module Control.Monad.IO.Unlift
, BS.ByteString
, SomeException
, MonadFail
, TestFn(..)
, truncateTimeOfDay
, truncateToMicro
, truncateUTCTime
, arbText
, liftA2
, changeBackend
, Proxy(..)
, UUID(..)
, sqlSettingsUuid
) where
#if !MIN_VERSION_monad_logger(0,3,30)
import qualified Control.Monad.Fail as MonadFail
import Control.Monad.IO.Class
import Control.Monad.Logger
#endif
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource
import Control.Monad.Trans.Resource.Internal
import Control.Applicative (liftA2, (<|>))
import Control.Exception (SomeException)
import Control.Monad (forM_, liftM, replicateM, void, when)
import Control.Monad.Fail (MonadFail)
import Control.Monad.Reader
import Data.Char (GeneralCategory(..), generalCategory)
import Data.Fixed (Micro, Pico)
import Data.Proxy
import Data.String (IsString, fromString)
import qualified Data.Text as T
import Data.Time
import Test.Hspec
import Test.QuickCheck.Instances ()
import Data.Aeson (FromJSON, ToJSON, Value(..))
import qualified Data.Text.Encoding as TE
import Database.Persist.ImplicitIdDef (mkImplicitIdDef)
import Database.Persist.TH
( MkPersistSettings(..)
, mkMigrate
, mkPersist
, persistLowerCase
, persistUpperCase
, setImplicitIdDef
, share
, sqlSettings
)
import Web.Internal.HttpApiData
import Web.PathPieces
import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=))
import Test.QuickCheck
import Control.Monad (unless, (>=>))
import Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Data.ByteString as BS
import Data.IORef
import Data.Text (Text, unpack)
import System.Environment (getEnvironment)
import System.IO.Unsafe
import Database.Persist
import Database.Persist.Sql
import Database.Persist.TH ()
import Data.Int (Int32, Int64)
asIO :: IO a -> IO a
asIO :: IO a -> IO a
asIO IO a
a = IO a
a
(@/=), (@==), (==@) :: (HasCallStack, Eq a, Show a, MonadIO m) => a -> a -> m ()
infix 1 @/=
a
actual @/= :: a -> a -> m ()
@/= a
expected = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> a -> a -> IO ()
forall a. (Eq a, Show a, HasCallStack) => String -> a -> a -> IO ()
assertNotEqual String
"" a
expected a
actual
infix 1 @==, ==@
a
actual @== :: a -> a -> m ()
@== a
expected = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ a
actual a -> a -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= a
expected
a
expected ==@ :: a -> a -> m ()
==@ a
actual = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ a
expected a -> a -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@=? a
actual
assertNotEqual :: (Eq a, Show a, HasCallStack) => String -> a -> a -> Assertion
assertNotEqual :: String -> a -> a -> IO ()
assertNotEqual String
preface a
expected a
actual =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
expected) (String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure String
msg)
where msg :: String
msg = (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
preface then String
"" else String
preface String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n to not equal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
assertEmpty :: (MonadIO m) => [a] -> m ()
assertEmpty :: [a] -> m ()
assertEmpty [a]
xs = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"" ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs)
assertNotEmpty :: (MonadIO m) => [a] -> m ()
assertNotEmpty :: [a] -> m ()
assertNotEmpty [a]
xs = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"" (Bool -> Bool
not ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs))
isTravis :: IO Bool
isTravis :: IO Bool
isTravis = IO Bool
isCI
isCI :: IO Bool
isCI :: IO Bool
isCI = do
[(String, String)]
env <- IO [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"TRAVIS" [(String, String)]
env Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CI" [(String, String)]
env of
Just String
"true" -> Bool
True
Maybe String
_ -> Bool
False
persistSettings :: MkPersistSettings
persistSettings :: MkPersistSettings
persistSettings = MkPersistSettings
sqlSettings { mpsGeneric :: Bool
mpsGeneric = Bool
True }
instance Arbitrary PersistValue where
arbitrary :: Gen PersistValue
arbitrary = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue) -> Gen Int64 -> Gen PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Int64, Int64) -> Gen Int64
forall a. Random a => (a, a) -> Gen a
choose (Int64
0, Int64
forall a. Bounded a => a
maxBound)
instance PersistStore backend => Arbitrary (BackendKey backend) where
arbitrary :: Gen (BackendKey backend)
arbitrary = (Either Text (BackendKey backend) -> BackendKey backend
forall p. Either Text p -> p
errorLeft (Either Text (BackendKey backend) -> BackendKey backend)
-> (PersistValue -> Either Text (BackendKey backend))
-> PersistValue
-> BackendKey backend
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text (BackendKey backend)
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue) (PersistValue -> BackendKey backend)
-> Gen PersistValue -> Gen (BackendKey backend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Gen PersistValue
forall a. Arbitrary a => Gen a
arbitrary
where
errorLeft :: Either Text p -> p
errorLeft Either Text p
x = case Either Text p
x of
Left Text
e -> String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
e
Right p
r -> p
r
class GenerateKey backend where
generateKey :: IO (BackendKey backend)
instance GenerateKey SqlBackend where
generateKey :: IO (BackendKey SqlBackend)
generateKey = do
Int64
i <- IORef Int64 -> IO Int64
forall a. IORef a -> IO a
readIORef IORef Int64
keyCounter
IORef Int64 -> Int64 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int64
keyCounter (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)
BackendKey SqlBackend -> IO (BackendKey SqlBackend)
forall (m :: * -> *) a. Monad m => a -> m a
return (BackendKey SqlBackend -> IO (BackendKey SqlBackend))
-> BackendKey SqlBackend -> IO (BackendKey SqlBackend)
forall a b. (a -> b) -> a -> b
$ Int64 -> BackendKey SqlBackend
SqlBackendKey (Int64 -> BackendKey SqlBackend) -> Int64 -> BackendKey SqlBackend
forall a b. (a -> b) -> a -> b
$ Int64
i
keyCounter :: IORef Int64
keyCounter :: IORef Int64
keyCounter = IO (IORef Int64) -> IORef Int64
forall a. IO a -> a
unsafePerformIO (IO (IORef Int64) -> IORef Int64)
-> IO (IORef Int64) -> IORef Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
1
{-# NOINLINE keyCounter #-}
data TestFn entity where
TestFn
:: (Show a, Eq a)
=> String
-> (entity -> a)
-> TestFn entity
truncateTimeOfDay :: TimeOfDay -> Gen TimeOfDay
truncateTimeOfDay :: TimeOfDay -> Gen TimeOfDay
truncateTimeOfDay (TimeOfDay Int
h Int
m Pico
s) =
TimeOfDay -> Gen TimeOfDay
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay -> Gen TimeOfDay) -> TimeOfDay -> Gen TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m (Pico -> TimeOfDay) -> Pico -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ Pico -> Pico
truncateToMicro Pico
s
truncateToMicro :: Pico -> Pico
truncateToMicro :: Pico -> Pico
truncateToMicro Pico
p = let
p' :: Micro
p' = Rational -> Micro
forall a. Fractional a => Rational -> a
fromRational (Rational -> Micro) -> (Pico -> Rational) -> Pico -> Micro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Rational
forall a. Real a => a -> Rational
toRational (Pico -> Micro) -> Pico -> Micro
forall a b. (a -> b) -> a -> b
$ Pico
p :: Micro
in Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico) -> (Micro -> Rational) -> Micro -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micro -> Rational
forall a. Real a => a -> Rational
toRational (Micro -> Pico) -> Micro -> Pico
forall a b. (a -> b) -> a -> b
$ Micro
p' :: Pico
truncateUTCTime :: UTCTime -> Gen UTCTime
truncateUTCTime :: UTCTime -> Gen UTCTime
truncateUTCTime (UTCTime Day
d DiffTime
dift) = do
let pico :: Pico
pico = Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico) -> (DiffTime -> Rational) -> DiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational (DiffTime -> Pico) -> DiffTime -> Pico
forall a b. (a -> b) -> a -> b
$ DiffTime
dift :: Pico
picoi :: Integer
picoi= Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> Integer) -> (Pico -> Rational) -> Pico -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
1000000000000) (Rational -> Rational) -> (Pico -> Rational) -> Pico -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Rational
forall a. Real a => a -> Rational
toRational (Pico -> Integer) -> Pico -> Integer
forall a b. (a -> b) -> a -> b
$ Pico -> Pico
truncateToMicro Pico
pico :: Integer
d' :: Day
d' = Day -> Day -> Day
forall a. Ord a => a -> a -> a
max Day
d (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
1950 Int
1 Int
1
UTCTime -> Gen UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Gen UTCTime) -> UTCTime -> Gen UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
d' (DiffTime -> UTCTime) -> DiffTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
picosecondsToDiffTime Integer
picoi
arbText :: IsString s => Gen s
arbText :: Gen s
arbText =
String -> s
forall a. IsString a => String -> a
fromString
(String -> s) -> (Text -> String) -> Text -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter ((GeneralCategory -> [GeneralCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GeneralCategory]
forbidden) (GeneralCategory -> Bool)
-> (Char -> GeneralCategory) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> GeneralCategory
generalCategory)
(String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFFFF')
(String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0')
(String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
(Text -> s) -> Gen Text -> Gen s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
where forbidden :: [GeneralCategory]
forbidden = [GeneralCategory
NotAssigned, GeneralCategory
PrivateUse]
type Runner backend m =
( MonadIO m, MonadUnliftIO m, MonadFail m
, MonadThrow m, MonadBaseControl IO m
, PersistStoreWrite backend, PersistStoreWrite (BaseBackend backend)
, GenerateKey backend
, HasPersistBackend backend
, PersistUniqueWrite backend
, PersistQueryWrite backend
, backend ~ BaseBackend backend
, PersistQueryRead backend
)
type RunDb backend m = ReaderT backend m () -> IO ()
changeBackend
:: forall backend backend' m. MonadUnliftIO m
=> (backend -> backend')
-> RunDb backend m
-> RunDb backend' m
changeBackend :: (backend -> backend') -> RunDb backend m -> RunDb backend' m
changeBackend backend -> backend'
f RunDb backend m
runDb =
RunDb backend m
runDb RunDb backend m
-> (ReaderT backend' m () -> ReaderT backend m ())
-> RunDb backend' m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (backend -> m ()) -> ReaderT backend m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((backend -> m ()) -> ReaderT backend m ())
-> (ReaderT backend' m () -> backend -> m ())
-> ReaderT backend' m ()
-> ReaderT backend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((backend' -> m ()) -> (backend -> backend') -> backend -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. backend -> backend'
f) ((backend' -> m ()) -> backend -> m ())
-> (ReaderT backend' m () -> backend' -> m ())
-> ReaderT backend' m ()
-> backend
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT backend' m () -> backend' -> m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
#if !MIN_VERSION_monad_logger(0,3,30)
instance MonadFail (LoggingT (ResourceT IO)) where
fail = liftIO . MonadFail.fail
#endif
#if MIN_VERSION_resourcet(1,2,0)
instance MonadBase b m => MonadBase b (ResourceT m) where
liftBase :: b α -> ResourceT m α
liftBase = m α -> ResourceT m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> ResourceT m α) -> (b α -> m α) -> b α -> ResourceT m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where
type StM (ResourceT m) a = StM m a
liftBaseWith :: (RunInBase (ResourceT m) b -> b a) -> ResourceT m a
liftBaseWith RunInBase (ResourceT m) b -> b a
f = (IORef ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m a) -> ResourceT m a)
-> (IORef ReleaseMap -> m a) -> ResourceT m a
forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
reader' ->
(RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInBase ->
RunInBase (ResourceT m) b -> b a
f (RunInBase (ResourceT m) b -> b a)
-> RunInBase (ResourceT m) b -> b a
forall a b. (a -> b) -> a -> b
$ m a -> b (StM m a)
RunInBase m b
runInBase (m a -> b (StM m a))
-> (ResourceT m a -> m a) -> ResourceT m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ResourceT IORef ReleaseMap -> m a
r) -> IORef ReleaseMap -> m a
r IORef ReleaseMap
reader')
restoreM :: StM (ResourceT m) a -> ResourceT m a
restoreM = (IORef ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m a) -> ResourceT m a)
-> (StM m a -> IORef ReleaseMap -> m a) -> StM m a -> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IORef ReleaseMap -> m a
forall a b. a -> b -> a
const (m a -> IORef ReleaseMap -> m a)
-> (StM m a -> m a) -> StM m a -> IORef ReleaseMap -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
#endif
newtype UUID = UUID { UUID -> Text
unUUID :: Text }
deriving stock
(Int -> UUID -> String -> String
[UUID] -> String -> String
UUID -> String
(Int -> UUID -> String -> String)
-> (UUID -> String) -> ([UUID] -> String -> String) -> Show UUID
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UUID] -> String -> String
$cshowList :: [UUID] -> String -> String
show :: UUID -> String
$cshow :: UUID -> String
showsPrec :: Int -> UUID -> String -> String
$cshowsPrec :: Int -> UUID -> String -> String
Show, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
Eq, Eq UUID
Eq UUID
-> (UUID -> UUID -> Ordering)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> Ord UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmax :: UUID -> UUID -> UUID
>= :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c< :: UUID -> UUID -> Bool
compare :: UUID -> UUID -> Ordering
$ccompare :: UUID -> UUID -> Ordering
$cp1Ord :: Eq UUID
Ord, ReadPrec [UUID]
ReadPrec UUID
Int -> ReadS UUID
ReadS [UUID]
(Int -> ReadS UUID)
-> ReadS [UUID] -> ReadPrec UUID -> ReadPrec [UUID] -> Read UUID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UUID]
$creadListPrec :: ReadPrec [UUID]
readPrec :: ReadPrec UUID
$creadPrec :: ReadPrec UUID
readList :: ReadS [UUID]
$creadList :: ReadS [UUID]
readsPrec :: Int -> ReadS UUID
$creadsPrec :: Int -> ReadS UUID
Read)
deriving newtype
([UUID] -> Encoding
[UUID] -> Value
UUID -> Encoding
UUID -> Value
(UUID -> Value)
-> (UUID -> Encoding)
-> ([UUID] -> Value)
-> ([UUID] -> Encoding)
-> ToJSON UUID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UUID] -> Encoding
$ctoEncodingList :: [UUID] -> Encoding
toJSONList :: [UUID] -> Value
$ctoJSONList :: [UUID] -> Value
toEncoding :: UUID -> Encoding
$ctoEncoding :: UUID -> Encoding
toJSON :: UUID -> Value
$ctoJSON :: UUID -> Value
ToJSON, Value -> Parser [UUID]
Value -> Parser UUID
(Value -> Parser UUID) -> (Value -> Parser [UUID]) -> FromJSON UUID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UUID]
$cparseJSONList :: Value -> Parser [UUID]
parseJSON :: Value -> Parser UUID
$cparseJSON :: Value -> Parser UUID
FromJSON, ByteString -> Either Text UUID
Text -> Either Text UUID
(Text -> Either Text UUID)
-> (ByteString -> Either Text UUID)
-> (Text -> Either Text UUID)
-> FromHttpApiData UUID
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text UUID
$cparseQueryParam :: Text -> Either Text UUID
parseHeader :: ByteString -> Either Text UUID
$cparseHeader :: ByteString -> Either Text UUID
parseUrlPiece :: Text -> Either Text UUID
$cparseUrlPiece :: Text -> Either Text UUID
FromHttpApiData, UUID -> ByteString
UUID -> Builder
UUID -> Text
(UUID -> Text)
-> (UUID -> Builder)
-> (UUID -> ByteString)
-> (UUID -> Text)
-> ToHttpApiData UUID
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: UUID -> Text
$ctoQueryParam :: UUID -> Text
toHeader :: UUID -> ByteString
$ctoHeader :: UUID -> ByteString
toEncodedUrlPiece :: UUID -> Builder
$ctoEncodedUrlPiece :: UUID -> Builder
toUrlPiece :: UUID -> Text
$ctoUrlPiece :: UUID -> Text
ToHttpApiData, Text -> Maybe UUID
UUID -> Text
(Text -> Maybe UUID) -> (UUID -> Text) -> PathPiece UUID
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
toPathPiece :: UUID -> Text
$ctoPathPiece :: UUID -> Text
fromPathPiece :: Text -> Maybe UUID
$cfromPathPiece :: Text -> Maybe UUID
PathPiece)
instance PersistFieldSql UUID where
sqlType :: Proxy UUID -> SqlType
sqlType Proxy UUID
_ = Text -> SqlType
SqlOther Text
"UUID"
instance PersistField UUID where
toPersistValue :: UUID -> PersistValue
toPersistValue (UUID Text
txt) =
LiteralType -> ByteString -> PersistValue
PersistLiteral_ LiteralType
Escaped (Text -> ByteString
TE.encodeUtf8 Text
txt)
fromPersistValue :: PersistValue -> Either Text UUID
fromPersistValue PersistValue
pv =
case PersistValue
pv of
PersistLiteral_ LiteralType
Escaped ByteString
bs ->
UUID -> Either Text UUID
forall a b. b -> Either a b
Right (UUID -> Either Text UUID) -> UUID -> Either Text UUID
forall a b. (a -> b) -> a -> b
$ Text -> UUID
UUID (ByteString -> Text
TE.decodeUtf8 ByteString
bs)
PersistValue
_ ->
Text -> Either Text UUID
forall a b. a -> Either a b
Left Text
"Nope"
sqlSettingsUuid :: Text -> MkPersistSettings
sqlSettingsUuid :: Text -> MkPersistSettings
sqlSettingsUuid Text
defExpr =
let
uuidDef :: ImplicitIdDef
uuidDef =
Text -> ImplicitIdDef
forall t. (Typeable t, PersistFieldSql t) => Text -> ImplicitIdDef
mkImplicitIdDef @UUID Text
defExpr
settings :: MkPersistSettings
settings =
ImplicitIdDef -> MkPersistSettings -> MkPersistSettings
setImplicitIdDef ImplicitIdDef
uuidDef MkPersistSettings
sqlSettings
in
MkPersistSettings
settings