Instead of using rawSql's Single, use a new data type Value.
First of all, Value is a nicer name than Single. However the main reason is to avoid error calls and to get better feedback about the code from GHC. Because of the GHC bug #6124, we had many calls to 'error' just to avoid spurious warnings. By using data (instead of newtype) for Value we're able to avoid them. This commit removes *19* error calls from Sql.hs that GHC is now able to prove that are unreachable.
This commit is contained in:
Felipe Lessa
parent
cc72ee9811
commit
f718be86da
@ -25,6 +25,7 @@ module Database.Esqueleto
|
||||
, (+.), (-.), (/.), (*.)
|
||||
, set, (=.), (+=.), (-=.), (*=.), (/=.) )
|
||||
, from
|
||||
, Value(..)
|
||||
, OrderBy
|
||||
-- ** Joins
|
||||
, InnerJoin(..)
|
||||
@ -191,8 +192,8 @@ import qualified Database.Persist.Store
|
||||
-- @
|
||||
--
|
||||
-- Since @age@ is an optional @Person@ field, we use 'just' lift
|
||||
-- @val 18 :: SqlExpr (Single Int)@ into @just (val 18) ::
|
||||
-- SqlExpr (Single (Just Int))@.
|
||||
-- @val 18 :: SqlExpr (Value Int)@ into @just (val 18) ::
|
||||
-- SqlExpr (Value (Just Int))@.
|
||||
--
|
||||
-- Implicit joins are represented by tuples. For example, to get
|
||||
-- the list of all blog posts and their authors, we could write:
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
module Database.Esqueleto.Internal.Language
|
||||
( Esqueleto(..)
|
||||
, from
|
||||
, Value(..)
|
||||
, InnerJoin(..)
|
||||
, CrossJoin(..)
|
||||
, LeftOuterJoin(..)
|
||||
@ -67,7 +68,7 @@ class (Functor query, Applicative query, Monad query) =>
|
||||
-> query a
|
||||
|
||||
-- | @WHERE@ clause: restrict the query's result.
|
||||
where_ :: expr (Single 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
|
||||
@ -118,75 +119,75 @@ class (Functor query, Applicative query, Monad query) =>
|
||||
-- If the order was *not* reversed, then @test2@ would be
|
||||
-- broken: @query1@'s 'on' would refer to @query2@'s
|
||||
-- 'LeftOuterJoin'.
|
||||
on :: expr (Single Bool) -> query ()
|
||||
on :: expr (Value Bool) -> query ()
|
||||
|
||||
-- | @ORDER BY@ clause. See also 'asc' and 'desc'.
|
||||
orderBy :: [expr OrderBy] -> query ()
|
||||
|
||||
-- | Ascending order of this field or expression.
|
||||
asc :: PersistField a => expr (Single a) -> expr OrderBy
|
||||
asc :: PersistField a => expr (Value a) -> expr OrderBy
|
||||
|
||||
-- | Descending order of this field or expression.
|
||||
desc :: PersistField a => expr (Single a) -> expr OrderBy
|
||||
desc :: PersistField a => expr (Value a) -> expr OrderBy
|
||||
|
||||
-- | Execute a subquery @SELECT@ in an expression.
|
||||
sub_select :: PersistField a => query (expr (Single a)) -> expr (Single a)
|
||||
sub_select :: PersistField a => query (expr (Value a)) -> expr (Value a)
|
||||
|
||||
-- | Execute a subquery @SELECT_DISTINCT@ in an expression.
|
||||
sub_selectDistinct :: PersistField a => query (expr (Single a)) -> expr (Single 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 (Single 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 (Single (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 (Single typ)
|
||||
val :: PersistField typ => typ -> expr (Value typ)
|
||||
|
||||
-- | @IS NULL@ comparison.
|
||||
isNothing :: PersistField typ => expr (Single (Maybe typ)) -> expr (Single Bool)
|
||||
isNothing :: PersistField typ => expr (Value (Maybe typ)) -> expr (Value Bool)
|
||||
|
||||
-- | Analog to 'Just', promotes a value of type @typ@ into one
|
||||
-- of type @Maybe typ@. It should hold that @val . Just ===
|
||||
-- just . val@.
|
||||
just :: expr (Single typ) -> expr (Single (Maybe typ))
|
||||
just :: expr (Value typ) -> expr (Value (Maybe typ))
|
||||
|
||||
-- | @NULL@ value.
|
||||
nothing :: expr (Single (Maybe typ))
|
||||
nothing :: expr (Value (Maybe typ))
|
||||
|
||||
-- | @COUNT(*)@ value.
|
||||
countRows :: Num a => expr (Single a)
|
||||
countRows :: Num a => expr (Value a)
|
||||
|
||||
not_ :: expr (Single Bool) -> expr (Single Bool)
|
||||
not_ :: expr (Value Bool) -> expr (Value Bool)
|
||||
|
||||
(==.) :: PersistField typ => expr (Single typ) -> expr (Single typ) -> expr (Single Bool)
|
||||
(>=.) :: PersistField typ => expr (Single typ) -> expr (Single typ) -> expr (Single Bool)
|
||||
(>.) :: PersistField typ => expr (Single typ) -> expr (Single typ) -> expr (Single Bool)
|
||||
(<=.) :: PersistField typ => expr (Single typ) -> expr (Single typ) -> expr (Single Bool)
|
||||
(<.) :: PersistField typ => expr (Single typ) -> expr (Single typ) -> expr (Single Bool)
|
||||
(!=.) :: PersistField typ => expr (Single typ) -> expr (Single typ) -> expr (Single 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 (Single Bool) -> expr (Single Bool) -> expr (Single Bool)
|
||||
(||.) :: expr (Single Bool) -> expr (Single Bool) -> expr (Single Bool)
|
||||
(&&.) :: expr (Value Bool) -> expr (Value Bool) -> expr (Value Bool)
|
||||
(||.) :: expr (Value Bool) -> expr (Value Bool) -> expr (Value Bool)
|
||||
|
||||
(+.) :: PersistField a => expr (Single a) -> expr (Single a) -> expr (Single a)
|
||||
(-.) :: PersistField a => expr (Single a) -> expr (Single a) -> expr (Single a)
|
||||
(/.) :: PersistField a => expr (Single a) -> expr (Single a) -> expr (Single a)
|
||||
(*.) :: PersistField a => expr (Single a) -> expr (Single a) -> expr (Single 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)
|
||||
|
||||
-- | @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 (Single typ) -> expr (Update val)
|
||||
(+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Single a) -> expr (Update val)
|
||||
(-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Single a) -> expr (Update val)
|
||||
(*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Single a) -> expr (Update val)
|
||||
(/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> expr (Single 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)
|
||||
|
||||
|
||||
-- Fixity declarations
|
||||
@ -198,6 +199,12 @@ infixr 3 &&., =., +=., -=., *=., /=.
|
||||
infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`
|
||||
|
||||
|
||||
-- | 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@.
|
||||
|
||||
|
||||
-- | Data type that represents an @INNER JOIN@ (see 'LeftOuterJoin' for an example).
|
||||
data InnerJoin a b = a `InnerJoin` b
|
||||
|
||||
|
||||
@ -86,18 +86,18 @@ instance Monoid SideData where
|
||||
-- | A part of a @FROM@ clause.
|
||||
data FromClause =
|
||||
FromStart Ident EntityDef
|
||||
| FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Single Bool)))
|
||||
| OnClause (SqlExpr (Single Bool))
|
||||
| FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool)))
|
||||
| OnClause (SqlExpr (Value Bool))
|
||||
|
||||
|
||||
-- | A part of a @SET@ clause.
|
||||
newtype SetClause = SetClause (SqlExpr (Single ()))
|
||||
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 (Single Bool)) [FromClause]
|
||||
collectOnClauses :: [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause]
|
||||
collectOnClauses = go []
|
||||
where
|
||||
go [] (f@(FromStart _ _):fs) = fmap (f:) (go [] fs) -- fast path
|
||||
@ -123,7 +123,7 @@ collectOnClauses = go []
|
||||
|
||||
|
||||
-- | A complete @WHERE@ clause.
|
||||
data WhereClause = Where (SqlExpr (Single Bool))
|
||||
data WhereClause = Where (SqlExpr (Value Bool))
|
||||
| NoWhere
|
||||
|
||||
instance Monoid WhereClause where
|
||||
@ -186,9 +186,9 @@ useIdent esc (I ident) = esc (DBName ident)
|
||||
data SqlExpr a where
|
||||
EEntity :: Ident -> SqlExpr (Entity val)
|
||||
EMaybe :: SqlExpr a -> SqlExpr (Maybe a)
|
||||
ERaw :: NeedParens -> (Escape -> (TLB.Builder, [PersistValue])) -> SqlExpr (Single a)
|
||||
EOrderBy :: OrderByType -> SqlExpr (Single a) -> SqlExpr OrderBy
|
||||
ESet :: (SqlExpr (Entity val) -> SqlExpr (Single ())) -> SqlExpr (Update val)
|
||||
ERaw :: NeedParens -> (Escape -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
|
||||
EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
|
||||
ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)
|
||||
EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a)
|
||||
|
||||
data NeedParens = Parens | Never
|
||||
@ -219,7 +219,6 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
||||
maybelize :: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
|
||||
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
|
||||
maybelize (EPreprocessedFrom ret from_) = EPreprocessedFrom (EMaybe ret) from_
|
||||
maybelize _ = error "Esqueleto/Sql/fromStartMaybe: never here (see GHC #6124)"
|
||||
|
||||
fromJoin (EPreprocessedFrom lhsRet lhsFrom)
|
||||
(EPreprocessedFrom rhsRet rhsFrom) = Q $ do
|
||||
@ -229,12 +228,10 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
||||
rhsFrom -- RHS
|
||||
Nothing -- ON
|
||||
return (EPreprocessedFrom ret from_)
|
||||
fromJoin _ _ = error "Esqueleto/Sql/fromJoin: never here (see GHC #6124)"
|
||||
|
||||
fromFinish (EPreprocessedFrom ret from_) = Q $ do
|
||||
W.tell mempty { sdFromClause = [from_] }
|
||||
return ret
|
||||
fromFinish _ = error "Esqueleto/Sql/fromFinish: never here (see GHC #6124)"
|
||||
|
||||
where_ expr = Q $ W.tell mempty { sdWhereClause = Where expr }
|
||||
|
||||
@ -249,27 +246,21 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
||||
|
||||
EEntity ident ^. field =
|
||||
ERaw Never $ \esc -> (useIdent esc ident <> ("." <> fieldName esc field), [])
|
||||
_ ^. _ = error "Esqueleto/Sql/(^.): never here (see GHC #6124)"
|
||||
|
||||
EMaybe r ?. field = maybelize (r ^. field)
|
||||
where
|
||||
maybelize :: SqlExpr (Single a) -> SqlExpr (Single (Maybe a))
|
||||
maybelize :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
|
||||
maybelize (ERaw p f) = ERaw p f
|
||||
maybelize _ = error "Esqueleto/Sql/(?.): never here 1 (see GHC #6124)"
|
||||
_ ?. _ = error "Esqueleto/Sql/(?.): never here 2 (see GHC #6124)"
|
||||
|
||||
val = ERaw Never . const . (,) "?" . return . toPersistValue
|
||||
|
||||
isNothing (ERaw p f) = ERaw Never $ first ((<> " IS NULL") . parensM p) . f
|
||||
isNothing _ = error "Esqueleto/Sql/isNothing: never here (see GHC #6124)"
|
||||
just (ERaw p f) = ERaw p f
|
||||
just _ = error "Esqueleto/Sql/just: never here (see GHC #6124)"
|
||||
nothing = ERaw Never $ \_ -> ("NULL", mempty)
|
||||
countRows = ERaw Never $ \_ -> ("COUNT(*)", mempty)
|
||||
|
||||
not_ (ERaw p f) = ERaw Never $ \esc -> let (b, vals) = f esc
|
||||
in ("NOT " <> parensM p b, vals)
|
||||
not_ _ = error "Esqueleto/Sql/not_: never here (see GHC #6124)"
|
||||
|
||||
(==.) = binop " = "
|
||||
(>=.) = binop " >= "
|
||||
@ -287,7 +278,6 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
||||
set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }
|
||||
where
|
||||
apply (ESet f) = SetClause (f ent)
|
||||
apply _ = error "Esqueleto/Sql/set/apply: never here (see GHC #6124)"
|
||||
|
||||
field =. expr = setAux field (const expr)
|
||||
field +=. expr = setAux field (\ent -> ent ^. field +. expr)
|
||||
@ -302,25 +292,24 @@ fieldName esc = esc . fieldDB . persistFieldDef
|
||||
|
||||
setAux :: (PersistEntity val, PersistField typ)
|
||||
=> EntityField val typ
|
||||
-> (SqlExpr (Entity val) -> SqlExpr (Single typ))
|
||||
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
|
||||
-> SqlExpr (Update val)
|
||||
setAux field mkVal = ESet $ \ent -> binop " = " name (mkVal ent)
|
||||
where name = ERaw Never $ \esc -> (fieldName esc field, mempty)
|
||||
|
||||
sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Single a)) -> SqlExpr (Single a)
|
||||
sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
|
||||
sub mode query = ERaw Parens $ \esc -> first parens (toRawSql mode esc query)
|
||||
|
||||
fromDBName :: Connection -> DBName -> TLB.Builder
|
||||
fromDBName conn = TLB.fromText . escapeName conn
|
||||
|
||||
binop :: TLB.Builder -> SqlExpr (Single a) -> SqlExpr (Single b) -> SqlExpr (Single c)
|
||||
binop :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
|
||||
binop op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f
|
||||
where
|
||||
f esc = let (b1, vals1) = f1 esc
|
||||
(b2, vals2) = f2 esc
|
||||
in ( parensM p1 b1 <> op <> parensM p2 b2
|
||||
, vals1 <> vals2 )
|
||||
binop _ _ _ = error "Esqueleto/Sql/binop: never here (see GHC #6124)"
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
@ -531,12 +520,11 @@ makeFrom esc mode fs = ret
|
||||
fromKind FullOuterJoinKind = " FULL OUTER JOIN "
|
||||
|
||||
makeOnClause (ERaw _ f) = first (" ON " <>) (f esc)
|
||||
makeOnClause _ = error "Esqueleto/Sql/makeFrom/makeOnClause: never here (see GHC #6124)"
|
||||
|
||||
mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException
|
||||
mkExc (ERaw _ f) =
|
||||
OnClauseWithoutMatchingJoinException $
|
||||
TL.unpack $ TLB.toLazyText $ fst (f esc)
|
||||
mkExc _ = OnClauseWithoutMatchingJoinException "???"
|
||||
|
||||
|
||||
makeSet :: Escape -> [SetClause] -> (TLB.Builder, [PersistValue])
|
||||
@ -544,13 +532,11 @@ makeSet _ [] = mempty
|
||||
makeSet esc os = first ("\nSET " <>) $ uncommas' (map mk os)
|
||||
where
|
||||
mk (SetClause (ERaw _ f)) = f esc
|
||||
mk _ = error "Esqueleto/Sql/makeSet: never here (see GHC #6124)"
|
||||
|
||||
|
||||
makeWhere :: Escape -> WhereClause -> (TLB.Builder, [PersistValue])
|
||||
makeWhere _ NoWhere = mempty
|
||||
makeWhere esc (Where (ERaw _ f)) = first ("\nWHERE " <>) (f esc)
|
||||
makeWhere _ _ = error "Esqueleto/Sql/makeWhere: never here (see GHC #6124)"
|
||||
|
||||
|
||||
makeOrderBy :: Escape -> [OrderByClause] -> (TLB.Builder, [PersistValue])
|
||||
@ -558,7 +544,6 @@ makeOrderBy _ [] = mempty
|
||||
makeOrderBy esc os = first ("\nORDER BY " <>) $ uncommas' (map mk os)
|
||||
where
|
||||
mk (EOrderBy t (ERaw _ f)) = first (<> orderByType t) (f esc)
|
||||
mk _ = error "Esqueleto/Sql/makeOrderBy: never here (see GHC #6124)"
|
||||
orderByType ASC = " ASC"
|
||||
orderByType DESC = " DESC"
|
||||
|
||||
@ -608,7 +593,6 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
|
||||
name = useIdent escape ident <> "."
|
||||
ret = let ed = entityDef $ getEntityVal expr
|
||||
in (process ed, mempty)
|
||||
sqlSelectCols _ _ = error "Esqueleto/Sql/sqlSelectCols[Entity]: never here (see GHC #6124)"
|
||||
sqlSelectColCount = (+1) . length . entityFields . entityDef . getEntityVal
|
||||
sqlSelectProcessRow (idCol:ent) =
|
||||
Entity <$> fromPersistValue idCol
|
||||
@ -620,7 +604,6 @@ getEntityVal = error "Esqueleto/Sql/getEntityVal"
|
||||
|
||||
instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where
|
||||
sqlSelectCols escape (EMaybe ent) = sqlSelectCols escape ent
|
||||
sqlSelectCols _ _ = error "Esqueleto/Sql/sqlSelectCols[Maybe Entity]: never here (see GHC #6124)"
|
||||
sqlSelectColCount = sqlSelectColCount . fromEMaybe
|
||||
where
|
||||
fromEMaybe :: SqlExpr (Maybe e) -> SqlExpr e
|
||||
@ -629,13 +612,12 @@ instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entit
|
||||
| all (== PersistNull) cols = return Nothing
|
||||
| otherwise = Just <$> sqlSelectProcessRow cols
|
||||
|
||||
instance PersistField a => SqlSelect (SqlExpr (Single a)) (Single a) where
|
||||
instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where
|
||||
sqlSelectCols esc (ERaw p f) = let (b, vals) = f esc
|
||||
in (parensM p b, vals)
|
||||
sqlSelectCols _ _ = error "Esqueleto/Sql/sqlSelectCols[Single]: never here (see GHC #6124)"
|
||||
sqlSelectColCount = const 1
|
||||
sqlSelectProcessRow [pv] = Single <$> fromPersistValue pv
|
||||
sqlSelectProcessRow _ = Left "SqlSelect (Single a): wrong number of columns."
|
||||
sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv
|
||||
sqlSelectProcessRow _ = Left "SqlSelect (Value a): wrong number of columns."
|
||||
|
||||
instance ( SqlSelect a ra
|
||||
, SqlSelect b rb
|
||||
|
||||
18
test/Test.hs
18
test/Test.hs
@ -59,12 +59,12 @@ main = do
|
||||
it "works for a single value" $
|
||||
run $ do
|
||||
ret <- select $ return $ val (3 :: Int)
|
||||
liftIO $ ret `shouldBe` [ Single 3 ]
|
||||
liftIO $ ret `shouldBe` [ Value 3 ]
|
||||
|
||||
it "works for a single NULL value" $
|
||||
run $ do
|
||||
ret <- select $ return $ nothing
|
||||
liftIO $ ret `shouldBe` [ Single (Nothing :: Maybe Int) ]
|
||||
liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ]
|
||||
|
||||
describe "select/from" $ do
|
||||
it "works for a simple example" $
|
||||
@ -102,8 +102,8 @@ main = do
|
||||
ret <- select $
|
||||
from $ \p ->
|
||||
return (p ^. PersonId, p ^. PersonName)
|
||||
liftIO $ ret `shouldBe` [ (Single p1k, Single (personName p1))
|
||||
, (Single p2k, Single (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
|
||||
@ -112,10 +112,10 @@ main = do
|
||||
ret <- select $
|
||||
from $ \(pa, pb) ->
|
||||
return (pa ^. PersonName, pb ^. PersonName)
|
||||
liftIO $ ret `shouldBe` [ (Single (personName p1), Single (personName p1))
|
||||
, (Single (personName p1), Single (personName p2))
|
||||
, (Single (personName p2), Single (personName p1))
|
||||
, (Single (personName p2), Single (personName p2)) ]
|
||||
liftIO $ ret `shouldBe` [ (Value (personName p1), Value (personName p1))
|
||||
, (Value (personName p1), Value (personName p2))
|
||||
, (Value (personName p2), Value (personName p1))
|
||||
, (Value (personName p2), Value (personName p2)) ]
|
||||
|
||||
describe "select/JOIN" $ do
|
||||
it "works with a LEFT OUTER JOIN" $
|
||||
@ -342,7 +342,7 @@ main = do
|
||||
let title = b ^. BlogPostTitle
|
||||
orderBy [asc title]
|
||||
return title
|
||||
liftIO $ ret `shouldBe` [ Single t1, Single t2, Single t3 ]
|
||||
liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ]
|
||||
|
||||
describe "delete" $
|
||||
it "works on a simple example" $
|
||||
|
||||
Loading…
Reference in New Issue
Block a user