esqueleto 0.1 → 0.2

raw patch · 5 files changed

+72/−83 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• esqueleto.cabal +1/−1
• src/Database/Esqueleto.hs +3/−2
• src/Database/Esqueleto/Internal/Language.hs +43/−37
• src/Database/Esqueleto/Internal/Sql.hs +16/−34
• test/Test.hs +9/−9

@@ -1,5 +1,5 @@ name:                esqueleto-version:             0.1+version:             0.2 synopsis:            Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage:            https://github.com/meteficha/esqueleto license:             BSD3

@@ -25,6 +25,7 @@              , (+.), (-.), (/.), (*.)              , set, (=.), (+=.), (-=.), (*=.), (/=.) )   , from+  , Value(..)   , OrderBy     -- ** Joins   , InnerJoin(..)@@ -191,8 +192,8 @@ -- @ -- -- 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 @@     -> 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 @@   -- 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@@ -195,17 +196,22 @@ infixl 6 +., -. infix  4 ==., >=., >., <=., <., !=. infixr 3 &&., =., +=., -=., *=., /=.-infixr 2 ||.-infixr 2 `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`+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 --- | Data type that represents an @CROSS JOIN@ (see 'LeftOuterJoin' for an example).+-- | Data type that represents a @CROSS JOIN@ (see 'LeftOuterJoin' for an example). data CrossJoin a b = a `CrossJoin` b --- | Data type that represents an @LEFT OUTER JOIN@. For example,+-- | Data type that represents a @LEFT OUTER JOIN@. For example, -- -- @ -- select $@@ -222,10 +228,10 @@ -- @ data LeftOuterJoin a b = a `LeftOuterJoin` b --- | Data type that represents an @RIGHT OUTER JOIN@ (see 'LeftOuterJoin' for an example).+-- | Data type that represents a @RIGHT OUTER JOIN@ (see 'LeftOuterJoin' for an example). data RightOuterJoin a b = a `RightOuterJoin` b --- | Data type that represents an @FULL OUTER JOIN@ (see 'LeftOuterJoin' for an example).+-- | Data type that represents a @FULL OUTER JOIN@ (see 'LeftOuterJoin' for an example). data FullOuterJoin a b = a `FullOuterJoin` b  

@@ -86,18 +86,18 @@ -- | 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 @@   -- | 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 @@ 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 @@       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 @@                          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 @@    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 @@   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 @@  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 @@     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 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 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 @@         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 @@  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 @@     | 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

@@ -59,12 +59,12 @@       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 @@           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 @@           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 @@                  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" $