diff --git a/esqueleto.cabal b/esqueleto.cabal --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.4.1.1 +version: 1.4.1.2 synopsis: Type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -50,6 +50,8 @@ , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) ) , from + , Value(..) + , unValue , ValueList(..) , OrderBy -- ** Joins @@ -370,7 +372,7 @@ -- | @valkey i = val (Key (PersistInt64 i))@ -- (). valkey :: Esqueleto query expr backend => - Int64 -> expr (Key entity) + Int64 -> expr (Value (Key entity)) valkey = val . Key . PersistInt64 diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -15,6 +15,8 @@ ( -- * The pretty face Esqueleto(..) , from + , Value(..) + , unValue , ValueList(..) , SomeValue(..) , ToSomeValues(..) @@ -80,7 +82,7 @@ -> query a -- | @WHERE@ clause: restrict the query's result. - where_ :: expr Bool -> query () + where_ :: expr (Value Bool) -> query () -- | @ON@ clause: restrict the a @JOIN@'s result. The @ON@ -- clause will be applied to the /last/ @JOIN@ that does not @@ -129,7 +131,7 @@ -- If the order was /not/ reversed, then @test2@ would be -- broken: @query1@'s 'on' would refer to @query2@'s -- 'LeftOuterJoin'. - on :: expr Bool -> query () + on :: expr (Value Bool) -> query () -- | @GROUP BY@ clause. You can enclose multiple columns -- in a tuple. @@ -143,7 +145,7 @@ -- -- With groupBy you can sort by aggregate functions, like so (we -- used @let@ to restrict the more general `countRows` to - -- @SqlExpr Int@ to avoid ambiguity): + -- @SqlExpr (Value Int)@ to avoid ambiguity): -- -- @ -- r \<- select $ from \\(foo ``InnerJoin`` bar) -> do @@ -152,7 +154,7 @@ -- let countRows' = countRows -- orderBy [asc countRows'] -- return (bar ^. BarName, countRows') - -- forM_ r $ \\(name, count) -> do + -- forM_ r $ \\((Value name), (Value count)) -> do -- print name -- print (count :: Int) -- @ @@ -162,10 +164,10 @@ orderBy :: [expr OrderBy] -> query () -- | Ascending order of this field or expression. - asc :: PersistField a => expr a -> expr OrderBy + asc :: PersistField a => expr (Value a) -> expr OrderBy -- | Descending order of this field or expression. - desc :: PersistField a => expr a -> expr OrderBy + desc :: PersistField a => expr (Value a) -> expr OrderBy -- | @LIMIT@. Limit the number of returned rows. limit :: Int64 -> query () @@ -181,78 +183,78 @@ -- | @HAVING@. -- -- /Since: 1.2.2/ - having :: expr Bool -> query () + having :: expr (Value Bool) -> query () -- | Execute a subquery @SELECT@ in an expression. Returns a -- simple value so should be used only when the @SELECT@ query -- is guaranteed to return just one row. - sub_select :: PersistField a => query (expr a) -> expr a + sub_select :: PersistField a => query (expr (Value a)) -> expr (Value a) -- | Same as 'sub_select' but using @SELECT DISTINCT@. - sub_selectDistinct :: PersistField a => query (expr a) -> expr a + sub_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (Value a) -- | Project a field of an entity. (^.) :: (PersistEntity val, PersistField typ) => - expr (Entity val) -> EntityField val typ -> expr typ + expr (Entity val) -> EntityField val typ -> expr (Value typ) -- | Project a field of an entity that may be null. (?.) :: (PersistEntity val, PersistField typ) => - expr (Maybe (Entity val)) -> EntityField val typ -> expr (Maybe typ) + expr (Maybe (Entity val)) -> EntityField val typ -> expr (Value (Maybe typ)) -- | Lift a constant value from Haskell-land to the query. - val :: PersistField typ => typ -> expr typ + val :: PersistField typ => typ -> expr (Value typ) -- | @IS NULL@ comparison. - isNothing :: PersistField typ => expr (Maybe typ) -> expr Bool + isNothing :: PersistField typ => expr (Value (Maybe typ)) -> expr (Value Bool) -- | Analogous to 'Just', promotes a value of type @typ@ into -- one of type @Maybe typ@. It should hold that @val . Just -- === just . val@. - just :: expr typ -> expr (Maybe typ) + just :: expr (Value typ) -> expr (Value (Maybe typ)) -- | @NULL@ value. - nothing :: expr (Maybe typ) + nothing :: expr (Value (Maybe typ)) -- | Join nested 'Maybe's in a 'Value' into one. This is useful when -- calling aggregate functions on nullable fields. - joinV :: expr (Maybe (Maybe typ)) -> expr (Maybe typ) + joinV :: expr (Value (Maybe (Maybe typ))) -> expr (Value (Maybe typ)) -- | @COUNT(*)@ value. - countRows :: Num a => expr a + countRows :: Num a => expr (Value a) -- | @COUNT@. - count :: (Num a) => expr typ -> expr a + count :: (Num a) => expr (Value typ) -> expr (Value a) - not_ :: expr Bool -> expr Bool + not_ :: expr (Value Bool) -> expr (Value Bool) - (==.) :: PersistField typ => expr typ -> expr typ -> expr Bool - (>=.) :: PersistField typ => expr typ -> expr typ -> expr Bool - (>.) :: PersistField typ => expr typ -> expr typ -> expr Bool - (<=.) :: PersistField typ => expr typ -> expr typ -> expr Bool - (<.) :: PersistField typ => expr typ -> expr typ -> expr Bool - (!=.) :: PersistField typ => expr typ -> expr typ -> expr Bool + (==.) :: PersistField typ => expr (Value typ) -> expr (Value typ) -> expr (Value Bool) + (>=.) :: PersistField typ => expr (Value typ) -> expr (Value typ) -> expr (Value Bool) + (>.) :: PersistField typ => expr (Value typ) -> expr (Value typ) -> expr (Value Bool) + (<=.) :: PersistField typ => expr (Value typ) -> expr (Value typ) -> expr (Value Bool) + (<.) :: PersistField typ => expr (Value typ) -> expr (Value typ) -> expr (Value Bool) + (!=.) :: PersistField typ => expr (Value typ) -> expr (Value typ) -> expr (Value Bool) - (&&.) :: expr Bool -> expr Bool -> expr Bool - (||.) :: expr Bool -> expr Bool -> expr Bool + (&&.) :: expr (Value Bool) -> expr (Value Bool) -> expr (Value Bool) + (||.) :: expr (Value Bool) -> expr (Value Bool) -> expr (Value Bool) - (+.) :: PersistField a => expr a -> expr a -> expr a - (-.) :: PersistField a => expr a -> expr a -> expr a - (/.) :: PersistField a => expr a -> expr a -> expr a - (*.) :: PersistField a => expr a -> expr a -> expr a + (+.) :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a) + (-.) :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a) + (/.) :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a) + (*.) :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a) - random_ :: (PersistField a, Num a) => expr a - round_ :: (PersistField a, Num a, PersistField b, Num b) => expr a -> expr b - ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => expr a -> expr b - floor_ :: (PersistField a, Num a, PersistField b, Num b) => expr a -> expr b + random_ :: (PersistField a, Num a) => expr (Value a) + round_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) + ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) + floor_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) - sum_ :: (PersistField a, PersistField b) => expr a -> expr (Maybe b) - min_ :: (PersistField a) => expr a -> expr (Maybe a) - max_ :: (PersistField a) => expr a -> expr (Maybe a) - avg_ :: (PersistField a, PersistField b) => expr a -> expr (Maybe b) + sum_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) + min_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + max_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + avg_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) -- | @LIKE@ operator. - like :: (PersistField s, IsString s) => expr s -> expr s -> expr Bool + like :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value Bool) -- | The string @'%'@. May be useful while using 'like' and -- concatenation ('concat_' or '++.', depending on your -- database). Note that you always to type the parenthesis, @@ -261,30 +263,30 @@ -- @ -- name ``'like'`` (%) ++. val "John" ++. (%) -- @ - (%) :: (PersistField s, IsString s) => expr s + (%) :: (PersistField s, IsString s) => expr (Value s) -- | The @CONCAT@ function with a variable number of -- parameters. Supported by MySQL and PostgreSQL. - concat_ :: (PersistField s, IsString s) => [expr s] -> expr s + concat_ :: (PersistField s, IsString s) => [expr (Value s)] -> expr (Value s) -- | The @||@ string concatenation operator (named after -- Haskell's '++' in order to avoid naming clash with '||.'). -- Supported by SQLite and PostgreSQL. - (++.) :: (PersistField s, IsString s) => expr s -> expr s -> expr s + (++.) :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value s) -- | Execute a subquery @SELECT@ in an expression. Returns a -- list of values. - subList_select :: PersistField a => query (expr a) -> expr (ValueList a) + subList_select :: PersistField a => query (expr (Value a)) -> expr (ValueList a) -- | Same as 'sublist_select' but using @SELECT DISTINCT@. - subList_selectDistinct :: PersistField a => query (expr a) -> expr (ValueList a) + subList_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (ValueList a) -- | Lift a list of constant value from Haskell-land to the query. valList :: PersistField typ => [typ] -> expr (ValueList typ) -- | @IN@ operator. - in_ :: PersistField typ => expr typ -> expr (ValueList typ) -> expr Bool + in_ :: PersistField typ => expr (Value typ) -> expr (ValueList typ) -> expr (Value Bool) -- | @NOT IN@ operator. - notIn :: PersistField typ => expr typ -> expr (ValueList typ) -> expr Bool + notIn :: PersistField typ => expr (Value typ) -> expr (ValueList typ) -> expr (Value Bool) -- | @EXISTS@ operator. For example: -- @@ -296,27 +298,27 @@ -- where_ (post ^. BlogPostAuthorId ==. person ^. PersonId) -- return person -- @ - exists :: query () -> expr Bool + exists :: query () -> expr (Value Bool) -- | @NOT EXISTS@ operator. - notExists :: query () -> expr Bool + notExists :: query () -> expr (Value Bool) -- | @SET@ clause used on @UPDATE@s. Note that while it's not -- a type error to use this function on a @SELECT@, it will -- most certainly result in a runtime error. set :: PersistEntity val => expr (Entity val) -> [expr (Update val)] -> query () - (=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> expr typ -> expr (Update val) - (+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr a -> expr (Update val) - (-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr a -> expr (Update val) - (*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr a -> expr (Update val) - (/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr a -> expr (Update val) + (=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> expr (Value typ) -> expr (Update val) + (+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Value a) -> expr (Update val) + (-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Value a) -> expr (Update val) + (*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Value a) -> expr (Update val) + (/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Value a) -> expr (Update val) -- | Apply a 'PersistField' constructor to @expr Value@ arguments. - (<#) :: (a -> b) -> expr a -> expr (Insertion b) + (<#) :: (a -> b) -> expr (Value a) -> expr (Insertion b) -- | Apply extra @expr Value@ arguments to a 'PersistField' constructor - (<&>) :: expr (Insertion (a -> b)) -> expr a -> expr (Insertion b) + (<&>) :: expr (Insertion (a -> b)) -> expr (Value a) -> expr (Insertion b) -- Fixity declarations @@ -329,6 +331,20 @@ infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`, `like` +-- | A single value (as opposed to a whole entity). You may use +-- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. +data Value a = Value a deriving (Eq, Ord, Show, Typeable) +-- Note: because of GHC bug #6124 we use @data@ instead of @newtype@. +-- + + +-- | Unwrap a 'Value'. +-- +-- /Since: 1.4.1/ +unValue :: Value a -> a +unValue (Value a) = a + + -- | A list of single values. There's a limited set of functions -- able to work with this data type (such as 'subList_select', -- 'valList', 'in_' and 'exists'). @@ -337,9 +353,9 @@ -- --- | A wrapper type for for any @expr a@ for all a. +-- | A wrapper type for for any @expr (Value a)@ for all a. data SomeValue expr where - SomeValue :: Esqueleto query expr backend => expr a -> SomeValue expr + SomeValue :: Esqueleto query expr backend => expr (Value a) -> SomeValue expr -- | A class of things that can be converted into a list of SomeValue. It has -- instances for tuples and is the reason why groupBy can take tuples, like diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -7,8 +7,6 @@ , MultiParamTypeClasses , OverloadedStrings , UndecidableInstances - , OverlappingInstances - , IncoherentInstances #-} -- | This is an internal module, anything exported by this module -- may change without a major version bump. Please use only @@ -114,18 +112,18 @@ -- | A part of a @FROM@ clause. data FromClause = FromStart Ident (EntityDef SqlType) - | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr Bool)) - | OnClause (SqlExpr Bool) + | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool))) + | OnClause (SqlExpr (Value Bool)) -- | A part of a @SET@ clause. -newtype SetClause = SetClause (SqlExpr ()) +newtype SetClause = SetClause (SqlExpr (Value ())) -- | Collect 'OnClause's on 'FromJoin's. Returns the first -- unmatched 'OnClause's data on error. Returns a list without -- 'OnClauses' on success. -collectOnClauses :: [FromClause] -> Either (SqlExpr Bool) [FromClause] +collectOnClauses :: [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause] collectOnClauses = go [] where go [] (f@(FromStart _ _):fs) = fmap (f:) (go [] fs) -- fast path @@ -151,7 +149,7 @@ -- | A complete @WHERE@ clause. -data WhereClause = Where (SqlExpr Bool) +data WhereClause = Where (SqlExpr (Value Bool)) | NoWhere instance Monoid WhereClause where @@ -249,18 +247,18 @@ -- connection (mainly for escaping names) and returns both an -- string ('TLB.Builder') and a list of values to be -- interpolated by the SQL backend. - ERaw :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a + ERaw :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) -- 'EList' and 'EEmptyList' are used by list operators. - EList :: SqlExpr a -> SqlExpr (ValueList a) + EList :: SqlExpr (Value a) -> SqlExpr (ValueList a) EEmptyList :: SqlExpr (ValueList a) -- A 'SqlExpr' accepted only by 'orderBy'. - EOrderBy :: OrderByType -> SqlExpr a -> SqlExpr OrderBy + EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy EOrderRandom :: SqlExpr OrderBy -- A 'SqlExpr' accepted only by 'set'. - ESet :: (SqlExpr (Entity val) -> SqlExpr ()) -> SqlExpr (Update val) + ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val) -- An internal 'SqlExpr' used by the 'from' hack. EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a) @@ -337,7 +335,7 @@ EMaybe r ?. field = maybelize (r ^. field) where - maybelize :: SqlExpr a -> SqlExpr (Maybe a) + maybelize :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a)) maybelize (ERaw p f) = ERaw p f val = ERaw Never . const . (,) "?" . return . toPersistValue @@ -411,7 +409,7 @@ in (fb <> ", " <> gb, fv ++ gv) -instance ToSomeValues SqlExpr (SqlExpr a) where +instance ToSomeValues SqlExpr (SqlExpr (Value a)) where toSomeValues a = [SomeValue a] fieldName :: (PersistEntity val, PersistField typ) @@ -420,24 +418,24 @@ setAux :: (PersistEntity val, PersistField typ) => EntityField val typ - -> (SqlExpr (Entity val) -> SqlExpr typ) + -> (SqlExpr (Entity val) -> SqlExpr (Value typ)) -> SqlExpr (Update val) setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent) where name = ERaw Never $ \info -> (fieldName info field, mempty) -sub :: PersistField a => Mode -> SqlQuery (SqlExpr a) -> SqlExpr a +sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) sub mode query = ERaw Parens $ \info -> toRawSql mode info query fromDBName :: IdentInfo -> DBName -> TLB.Builder fromDBName (conn, _) = TLB.fromText . connEscapeName conn -existsHelper :: SqlQuery () -> SqlExpr Bool +existsHelper :: SqlQuery () -> SqlExpr (Value Bool) existsHelper = sub SELECT . (>> return true) where - true :: SqlExpr Bool + true :: SqlExpr (Value Bool) true = val True -ifNotEmptyList :: SqlExpr (ValueList a) -> Bool -> SqlExpr Bool -> SqlExpr Bool +ifNotEmptyList :: SqlExpr (ValueList a) -> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) ifNotEmptyList EEmptyList b _ = val b ifNotEmptyList (EList _) _ x = x @@ -451,13 +449,13 @@ -- signature. For example: -- -- @ --- (==.) :: SqlExpr a -> SqlExpr a -> SqlExpr Bool +-- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool) -- (==.) = unsafeSqlBinOp " = " -- @ -- -- In the example above, we constraint the arguments to be of the -- same type and constraint the result to be a boolean value. -unsafeSqlBinOp :: TLB.Builder -> SqlExpr a -> SqlExpr b -> SqlExpr c +unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f where f info = let (b1, vals1) = f1 info @@ -469,7 +467,7 @@ -- | (Internal) A raw SQL value. The same warning from -- 'unsafeSqlBinOp' applies to this function as well. -unsafeSqlValue :: TLB.Builder -> SqlExpr a +unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a) unsafeSqlValue v = ERaw Never $ \_ -> (v, mempty) {-# INLINE unsafeSqlValue #-} @@ -477,7 +475,7 @@ -- | (Internal) A raw SQL function. Once again, the same warning -- from 'unsafeSqlBinOp' applies to this function as well. unsafeSqlFunction :: UnsafeSqlFunctionArgument a => - TLB.Builder -> a -> SqlExpr b + TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlFunction name arg = ERaw Never $ \info -> let (argsTLB, argsVals) = @@ -489,7 +487,7 @@ -- -- Since: 1.3.6. unsafeSqlExtractSubField :: UnsafeSqlFunctionArgument a => - TLB.Builder -> a -> SqlExpr b + TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlExtractSubField subField arg = ERaw Never $ \info -> let (argsTLB, argsVals) = @@ -498,8 +496,8 @@ class UnsafeSqlFunctionArgument a where - toArgList :: a -> [SqlExpr ()] -instance (a ~ b) => UnsafeSqlFunctionArgument (SqlExpr a) where + toArgList :: a -> [SqlExpr (Value ())] +instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where toArgList = (:[]) . veryUnsafeCoerceSqlExprValue instance UnsafeSqlFunctionArgument a => UnsafeSqlFunctionArgument [a] where @@ -522,16 +520,16 @@ --- | (Internal) Coerce a value's type from 'SqlExpr a' to --- 'SqlExpr b'. You should /not/ use this function +-- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to +-- 'SqlExpr (Value b)'. You should /not/ use this function -- unless you know what you're doing! -veryUnsafeCoerceSqlExprValue :: SqlExpr a -> SqlExpr b +veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList --- a)' to 'SqlExpr a'. Does not work with empty lists. -veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr a +-- a)' to 'SqlExpr (Value a)'. Does not work with empty lists. +veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a) veryUnsafeCoerceSqlExprValueList (EList v) = v veryUnsafeCoerceSqlExprValueList EEmptyList = error "veryUnsafeCoerceSqlExprValueList: empty list." @@ -566,7 +564,7 @@ Just (Left err) -> liftIO $ throwIO $ PersistMarshalError err Nothing -> return () - process = sqlSelectProcessRow query + process = sqlSelectProcessRow -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s @@ -875,7 +873,7 @@ makeOnClause (ERaw _ f) = first (" ON " <>) (f info) - mkExc :: SqlExpr Bool -> OnClauseWithoutMatchingJoinException + mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException mkExc (ERaw _ f) = OnClauseWithoutMatchingJoinException $ TL.unpack $ TLB.toLazyText $ fst (f info) @@ -935,17 +933,17 @@ -- This looks very similar to @RawSql@, and it is! However, -- there are some crucial differences and ultimately they're -- different classes. -class SqlSelect a r | a -> r where +class SqlSelect a r | a -> r, r -> a where -- | Creates the variable part of the @SELECT@ query and -- returns the list of 'PersistValue's that will be given to -- 'rawQuery'. sqlSelectCols :: IdentInfo -> a -> (TLB.Builder, [PersistValue]) -- | Number of columns that will be consumed. - sqlSelectColCount :: proxy a -> Int + sqlSelectColCount :: Proxy a -> Int -- | Transform a row of the result into the data type. - sqlSelectProcessRow :: proxy a -> [PersistValue] -> Either T.Text r + sqlSelectProcessRow :: [PersistValue] -> Either T.Text r -- | Create @INSERT INTO@ clause instead. sqlInsertInto :: IdentInfo -> a -> (TLB.Builder, [PersistValue]) @@ -962,8 +960,8 @@ table = fromDBName info . entityDB . entityDef $ p in ("INSERT INTO " <> table <> parens fields <> "\n", []) sqlSelectCols info (EInsertFinal (EInsert _ f)) = f info - sqlSelectColCount = const 0 - sqlSelectProcessRow _ = const (Right (error msg)) + sqlSelectColCount = const 0 + sqlSelectProcessRow = const (Right (error msg)) where msg = "sqlSelectProcessRow/SqlSelect/InsertionFinal: never here" @@ -972,7 +970,7 @@ instance SqlSelect () () where sqlSelectCols _ _ = ("1", []) sqlSelectColCount _ = 1 - sqlSelectProcessRow _ _ = Right () + sqlSelectProcessRow _ = Right () -- | You may return an 'Entity' from a 'select' query. @@ -991,16 +989,15 @@ -- name of the table (which doesn't allow self-joins, for -- example). name = useIdent info ident <> "." - ret = let ed = entityDef $ getEntityVal $ retProxy expr - retProxy = return :: a -> Proxy a + ret = let ed = entityDef $ getEntityVal $ return expr in (process ed, mempty) sqlSelectColCount = (+1) . length . entityFields . entityDef . getEntityVal - sqlSelectProcessRow _ (idCol:ent) = + sqlSelectProcessRow (idCol:ent) = Entity <$> fromPersistValue idCol <*> fromPersistValues ent - sqlSelectProcessRow _ _ = Left "SqlSelect (Entity a): wrong number of columns." + sqlSelectProcessRow _ = Left "SqlSelect (Entity a): wrong number of columns." -getEntityVal :: proxy (SqlExpr (Entity a)) -> Proxy a +getEntityVal :: Proxy (SqlExpr (Entity a)) -> Proxy a getEntityVal = const Proxy @@ -1008,22 +1005,22 @@ instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where sqlSelectCols info (EMaybe ent) = sqlSelectCols info ent sqlSelectColCount = sqlSelectColCount . fromEMaybe - sqlSelectProcessRow proxy cols + where + fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e) + fromEMaybe = const Proxy + sqlSelectProcessRow cols | all (== PersistNull) cols = return Nothing - | otherwise = Just <$> sqlSelectProcessRow (fromEMaybe proxy) cols - -fromEMaybe :: proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e) -fromEMaybe = const Proxy + | otherwise = Just <$> sqlSelectProcessRow cols -- | You may return any single value (i.e. a single column) from -- a 'select' query. -instance PersistField a => SqlSelect (SqlExpr a) a where +instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where sqlSelectCols info (ERaw p f) = let (b, vals) = f info in (parensM p b, vals) sqlSelectColCount = const 1 - sqlSelectProcessRow _ [pv] = fromPersistValue pv - sqlSelectProcessRow _ _ = Left "SqlSelect a: wrong number of columns." + sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv + sqlSelectProcessRow _ = Left "SqlSelect (Value a): wrong number of columns." -- | You may return tuples (up to 16-tuples) and tuples of tuples @@ -1037,22 +1034,25 @@ , sqlSelectCols esc b ] sqlSelectColCount = uncurry (+) . (sqlSelectColCount *** sqlSelectColCount) . fromTuple - sqlSelectProcessRow proxy = - let (proxyFst, proxySnd) = fromTuple proxy - colCountFst = sqlSelectColCount proxyFst + where + fromTuple :: Proxy (a,b) -> (Proxy a, Proxy b) + fromTuple = const (Proxy, Proxy) + sqlSelectProcessRow = + let x = getType processRow + getType :: SqlSelect a r => (z -> Either y (r,x)) -> Proxy a + getType = const Proxy + colCountFst = sqlSelectColCount x + processRow row = let (rowFst, rowSnd) = splitAt colCountFst row - in (,) <$> sqlSelectProcessRow proxyFst rowFst - <*> sqlSelectProcessRow proxySnd rowSnd + in (,) <$> sqlSelectProcessRow rowFst + <*> sqlSelectProcessRow rowSnd in colCountFst `seq` processRow -- Avoids recalculating 'colCountFst'. -fromTuple :: proxy (a,b) -> (Proxy a, Proxy b) -fromTuple = const (Proxy, Proxy) - instance ( SqlSelect a ra , SqlSelect b rb , SqlSelect c rc @@ -1063,10 +1063,10 @@ , sqlSelectCols esc b , sqlSelectCols esc c ] - sqlSelectColCount = sqlSelectColCount . from3P - sqlSelectProcessRow = (fmap to3 .) . sqlSelectProcessRow . from3P + sqlSelectColCount = sqlSelectColCount . from3P + sqlSelectProcessRow = fmap to3 . sqlSelectProcessRow -from3P :: proxy (a,b,c) -> Proxy ((a,b),c) +from3P :: Proxy (a,b,c) -> Proxy ((a,b),c) from3P = const Proxy from3 :: (a,b,c) -> ((a,b),c) @@ -1089,9 +1089,9 @@ , sqlSelectCols esc d ] sqlSelectColCount = sqlSelectColCount . from4P - sqlSelectProcessRow = (fmap to4 .) . sqlSelectProcessRow . from4P + sqlSelectProcessRow = fmap to4 . sqlSelectProcessRow -from4P :: proxy (a,b,c,d) -> Proxy ((a,b),(c,d)) +from4P :: Proxy (a,b,c,d) -> Proxy ((a,b),(c,d)) from4P = const Proxy from4 :: (a,b,c,d) -> ((a,b),(c,d)) @@ -1116,9 +1116,9 @@ , sqlSelectCols esc e ] sqlSelectColCount = sqlSelectColCount . from5P - sqlSelectProcessRow = (fmap to5 .) . sqlSelectProcessRow . from5P + sqlSelectProcessRow = fmap to5 . sqlSelectProcessRow -from5P :: proxy (a,b,c,d,e) -> Proxy ((a,b),(c,d),e) +from5P :: Proxy (a,b,c,d,e) -> Proxy ((a,b),(c,d),e) from5P = const Proxy to5 :: ((a,b),(c,d),e) -> (a,b,c,d,e) @@ -1142,9 +1142,9 @@ , sqlSelectCols esc f ] sqlSelectColCount = sqlSelectColCount . from6P - sqlSelectProcessRow = (fmap to6 .) . sqlSelectProcessRow . from6P + sqlSelectProcessRow = fmap to6 . sqlSelectProcessRow -from6P :: proxy (a,b,c,d,e,f) -> Proxy ((a,b),(c,d),(e,f)) +from6P :: Proxy (a,b,c,d,e,f) -> Proxy ((a,b),(c,d),(e,f)) from6P = const Proxy to6 :: ((a,b),(c,d),(e,f)) -> (a,b,c,d,e,f) @@ -1170,9 +1170,9 @@ , sqlSelectCols esc g ] sqlSelectColCount = sqlSelectColCount . from7P - sqlSelectProcessRow = (fmap to7 .) . sqlSelectProcessRow . from7P + sqlSelectProcessRow = fmap to7 . sqlSelectProcessRow -from7P :: proxy (a,b,c,d,e,f,g) -> Proxy ((a,b),(c,d),(e,f),g) +from7P :: Proxy (a,b,c,d,e,f,g) -> Proxy ((a,b),(c,d),(e,f),g) from7P = const Proxy to7 :: ((a,b),(c,d),(e,f),g) -> (a,b,c,d,e,f,g) @@ -1200,9 +1200,9 @@ , sqlSelectCols esc h ] sqlSelectColCount = sqlSelectColCount . from8P - sqlSelectProcessRow = (fmap to8 .) . sqlSelectProcessRow . from8P + sqlSelectProcessRow = fmap to8 . sqlSelectProcessRow -from8P :: proxy (a,b,c,d,e,f,g,h) -> Proxy ((a,b),(c,d),(e,f),(g,h)) +from8P :: Proxy (a,b,c,d,e,f,g,h) -> Proxy ((a,b),(c,d),(e,f),(g,h)) from8P = const Proxy to8 :: ((a,b),(c,d),(e,f),(g,h)) -> (a,b,c,d,e,f,g,h) @@ -1231,9 +1231,9 @@ , sqlSelectCols esc i ] sqlSelectColCount = sqlSelectColCount . from9P - sqlSelectProcessRow = (fmap to9 .) . sqlSelectProcessRow . from9P + sqlSelectProcessRow = fmap to9 . sqlSelectProcessRow -from9P :: proxy (a,b,c,d,e,f,g,h,i) -> Proxy ((a,b),(c,d),(e,f),(g,h),i) +from9P :: Proxy (a,b,c,d,e,f,g,h,i) -> Proxy ((a,b),(c,d),(e,f),(g,h),i) from9P = const Proxy to9 :: ((a,b),(c,d),(e,f),(g,h),i) -> (a,b,c,d,e,f,g,h,i) @@ -1264,9 +1264,9 @@ , sqlSelectCols esc j ] sqlSelectColCount = sqlSelectColCount . from10P - sqlSelectProcessRow = (fmap to10 .) . sqlSelectProcessRow . from10P + sqlSelectProcessRow = fmap to10 . sqlSelectProcessRow -from10P :: proxy (a,b,c,d,e,f,g,h,i,j) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j)) +from10P :: Proxy (a,b,c,d,e,f,g,h,i,j) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j)) from10P = const Proxy to10 :: ((a,b),(c,d),(e,f),(g,h),(i,j)) -> (a,b,c,d,e,f,g,h,i,j) @@ -1300,9 +1300,9 @@ , sqlSelectCols esc k ] sqlSelectColCount = sqlSelectColCount . from11P - sqlSelectProcessRow = (fmap to11 .) . sqlSelectProcessRow . from11P + sqlSelectProcessRow = fmap to11 . sqlSelectProcessRow -from11P :: proxy (a,b,c,d,e,f,g,h,i,j,k) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),k) +from11P :: Proxy (a,b,c,d,e,f,g,h,i,j,k) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),k) from11P = const Proxy to11 :: ((a,b),(c,d),(e,f),(g,h),(i,j),k) -> (a,b,c,d,e,f,g,h,i,j,k) @@ -1337,9 +1337,9 @@ , sqlSelectCols esc l ] sqlSelectColCount = sqlSelectColCount . from12P - sqlSelectProcessRow = (fmap to12 .) . sqlSelectProcessRow . from12P + sqlSelectProcessRow = fmap to12 . sqlSelectProcessRow -from12P :: proxy (a,b,c,d,e,f,g,h,i,j,k,l) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) +from12P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) from12P = const Proxy to12 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) -> (a,b,c,d,e,f,g,h,i,j,k,l) @@ -1376,9 +1376,9 @@ , sqlSelectCols esc m ] sqlSelectColCount = sqlSelectColCount . from13P - sqlSelectProcessRow = (fmap to13 .) . sqlSelectProcessRow . from13P + sqlSelectProcessRow = fmap to13 . sqlSelectProcessRow -from13P :: proxy (a,b,c,d,e,f,g,h,i,j,k,l,m) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) +from13P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) from13P = const Proxy to13 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) -> (a,b,c,d,e,f,g,h,i,j,k,l,m) @@ -1417,9 +1417,9 @@ , sqlSelectCols esc n ] sqlSelectColCount = sqlSelectColCount . from14P - sqlSelectProcessRow = (fmap to14 .) . sqlSelectProcessRow . from14P + sqlSelectProcessRow = fmap to14 . sqlSelectProcessRow -from14P :: proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) +from14P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) from14P = const Proxy to14 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n) @@ -1460,9 +1460,9 @@ , sqlSelectCols esc o ] sqlSelectColCount = sqlSelectColCount . from15P - sqlSelectProcessRow = (fmap to15 .) . sqlSelectProcessRow . from15P + sqlSelectProcessRow = fmap to15 . sqlSelectProcessRow -from15P :: proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n, o) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) +from15P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n, o) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) from15P = const Proxy to15 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) @@ -1505,9 +1505,9 @@ , sqlSelectCols esc p ] sqlSelectColCount = sqlSelectColCount . from16P - sqlSelectProcessRow = (fmap to16 .) . sqlSelectProcessRow . from16P + sqlSelectProcessRow = fmap to16 . sqlSelectProcessRow -from16P :: proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) +from16P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) from16P = const Proxy to16 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -71,13 +71,13 @@ describe "select" $ do it "works for a single value" $ run $ do - ret <- select $ return $ (val 3 :: SqlExpr Int) - liftIO $ ret `shouldBe` [ 3 ] + ret <- select $ return $ val (3 :: Int) + liftIO $ ret `shouldBe` [ Value 3 ] it "works for a pair of a single value and ()" $ run $ do - ret <- select $ return (val 3 :: SqlExpr Int, ()) - liftIO $ ret `shouldBe` [ (3, ()) ] + ret <- select $ return (val (3 :: Int), ()) + liftIO $ ret `shouldBe` [ (Value 3, ()) ] it "works for a single ()" $ run $ do @@ -86,8 +86,8 @@ it "works for a single NULL value" $ run $ do - ret <- select $ return $ (nothing :: SqlExpr (Maybe Int)) - liftIO $ ret `shouldBe` [ Nothing ] + ret <- select $ return $ nothing + liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] describe "select/from" $ do it "works for a simple example" $ @@ -95,15 +95,14 @@ p1e <- insert' p1 ret <- select $ from $ \person -> - return (person :: SqlExpr (Entity Person)) + return person liftIO $ ret `shouldBe` [ p1e ] it "works for a simple self-join (one entity)" $ run $ do p1e <- insert' p1 ret <- select $ - from $ \(person1, person2) -> do - let _ = person1 `asTypeOf` person2 :: SqlExpr (Entity Person) + from $ \(person1, person2) -> return (person1, person2) liftIO $ ret `shouldBe` [ (p1e, p1e) ] @@ -112,8 +111,7 @@ p1e <- insert' p1 p2e <- insert' p2 ret <- select $ - from $ \(person1, person2) -> do - let _ = person1 `asTypeOf` person2 :: SqlExpr (Entity Person) + from $ \(person1, person2) -> return (person1, person2) liftIO $ ret `shouldSatisfy` sameElementsAs [ (p1e, p1e) , (p1e, p2e) @@ -156,24 +154,23 @@ p1k <- insert p1 p2k <- insert p2 ret <- select $ - from $ \(p :: SqlExpr (Entity Person)) -> + from $ \p -> return (p ^. PersonId, p ^. PersonName) - liftIO $ ret `shouldBe` [ (p1k, personName p1) - , (p2k, personName p2) ] + liftIO $ ret `shouldBe` [ (Value p1k, Value (personName p1)) + , (Value p2k, Value (personName p2)) ] it "works for a simple projection with a simple implicit self-join" $ run $ do _ <- insert p1 _ <- insert p2 ret <- select $ - from $ \(pa, pb) -> do - let _ = pa `asTypeOf` pb :: SqlExpr (Entity Person) + from $ \(pa, pb) -> return (pa ^. PersonName, pb ^. PersonName) liftIO $ ret `shouldSatisfy` sameElementsAs - [ (personName p1, personName p1) - , (personName p1, personName p2) - , (personName p2, personName p1) - , (personName p2, personName p2) ] + [ (Value (personName p1), Value (personName p1)) + , (Value (personName p1), Value (personName p2)) + , (Value (personName p2), Value (personName p1)) + , (Value (personName p2), Value (personName p2)) ] it "works with many kinds of LIMITs and OFFSETs" $ run $ do @@ -325,14 +322,14 @@ _ <- insert' p3 _ <- insert' p4 ret <- select $ - from $ \(p :: SqlExpr (Entity Person)) -> + from $ \p-> return $ joinV $ sum_ (p ^. PersonAge) #if defined(WITH_POSTGRESQL) - liftIO $ ret `shouldBe` [ Just (36 + 17 + 17 :: Rational ) ] + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ] #elif defined(WITH_MYSQL) - liftIO $ ret `shouldBe` [ Just (36 + 17 + 17 :: Double ) ] + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ] #else - liftIO $ ret `shouldBe` [ Just (36 + 17 + 17 :: Int) ] + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ] #endif it "works with avg_" $ @@ -342,9 +339,9 @@ _ <- insert' p3 _ <- insert' p4 ret <- select $ - from $ \(p :: SqlExpr (Entity Person)) -> + from $ \p-> return $ joinV $ avg_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Just ((36 + 17 + 17) / 3 :: Double) ] + liftIO $ ret `shouldBe` [ Value $ Just ((36 + 17 + 17) / 3 :: Double) ] it "works with min_" $ run $ do @@ -353,9 +350,9 @@ _ <- insert' p3 _ <- insert' p4 ret <- select $ - from $ \(p :: SqlExpr (Entity Person)) -> + from $ \p-> return $ joinV $ min_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Just (17 :: Int) ] + liftIO $ ret `shouldBe` [ Value $ Just (17 :: Int) ] it "works with max_" $ run $ do @@ -364,23 +361,23 @@ _ <- insert' p3 _ <- insert' p4 ret <- select $ - from $ \(p :: SqlExpr (Entity Person)) -> + from $ \p-> return $ joinV $ max_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Just (36 :: Int) ] + liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ] it "works with random_" $ run $ do #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL) _ <- select $ return (random_ :: SqlExpr (Value Double)) #else - _ <- select $ return (random_ :: SqlExpr Int) + _ <- select $ return (random_ :: SqlExpr (Value Int)) #endif return () it "works with round_" $ run $ do - ret <- select $ return (round_ $ val (16.2 :: Double) :: SqlExpr Double) - liftIO $ ret `shouldBe` [ 16 ] + ret <- select $ return $ round_ (val (16.2 :: Double)) + liftIO $ ret `shouldBe` [ Value (16 :: Double) ] it "works with isNothing" $ run $ do @@ -529,7 +526,7 @@ return (p ^. PersonName) ] return (b ^. BlogPostId) - liftIO $ ret `shouldBe` [b2k, b3k, b4k, b1k] + liftIO $ ret `shouldBe` (Value <$> [b2k, b3k, b4k, b1k]) it "works with asc random_" $ run $ do @@ -542,8 +539,8 @@ replicateM 11 $ select $ from $ \p -> do - orderBy [asc (random_ :: SqlExpr Double)] - return (p ^. PersonId :: SqlExpr PersonId) + orderBy [asc (random_ :: SqlExpr (Value Double))] + return (p ^. PersonId :: SqlExpr (Value PersonId)) -- There are 2^4 = 16 possible orderings. The chance -- of 11 random samplings returning the same ordering -- is 1/2^40, so this test should pass almost everytime. @@ -561,7 +558,7 @@ let title = b ^. BlogPostTitle orderBy [asc title] return title - liftIO $ ret `shouldBe` [ t1, t2, t3 ] + liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ] describe "text functions" $ it "like, (%) and (++.) work on a simple example" $ @@ -676,9 +673,9 @@ let cnt = count (b ^. BlogPostId) orderBy [ asc cnt ] return (p, cnt) - liftIO $ ret `shouldBe` [ (Entity p2k p2, 0 :: Int) - , (Entity p1k p1, 3) - , (Entity p3k p3, 7) ] + liftIO $ ret `shouldBe` [ (Entity p2k p2, Value (0 :: Int)) + , (Entity p1k p1, Value 3) + , (Entity p3k p3, Value 7) ] it "GROUP BY works with HAVING" $ run $ do @@ -695,8 +692,8 @@ having (cnt >. (val 0)) orderBy [ asc cnt ] return (p, cnt) - liftIO $ ret `shouldBe` [ (Entity p1k p1, 3 :: Int) - , (Entity p3k p3, 7) ] + liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int)) + , (Entity p3k p3, Value 7) ] describe "lists of values" $ do it "IN works for valList" $ @@ -795,10 +792,8 @@ _ <- insert p3 insertSelect $ from $ \p -> do return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) - ret <- select $ - from $ \(_::(SqlExpr (Entity BlogPost))) -> - return (countRows :: SqlExpr Int) - liftIO $ ret `shouldBe` [3] + ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) + liftIO $ ret `shouldBe` [Value (3::Int)] describe "rand works" $ do it "returns result in random order" $ @@ -812,10 +807,10 @@ _ <- insert $ Person "Mark" Nothing _ <- insert $ Person "Sarah" Nothing insert $ Person "Paul" Nothing - ret1 <- select $ from $ \(p :: SqlExpr (Entity Person)) -> do + ret1 <- fmap (map unValue) $ select $ from $ \p -> do orderBy [rand] return (p ^. PersonId) - ret2 <- select $ from $ \(p :: SqlExpr (Entity Person)) -> do + ret2 <- fmap (map unValue) $ select $ from $ \p -> do orderBy [rand] return (p ^. PersonId)