diff --git a/src/Database/YeshQL.hs b/src/Database/YeshQL.hs --- a/src/Database/YeshQL.hs +++ b/src/Database/YeshQL.hs @@ -5,7 +5,7 @@ {-| Module: Database.YeshQL Description: Turn SQL queries into type-safe functions. -Copyright: (c) 2015 Tobias Dammers +Copyright: (c) 2015-2017 Tobias Dammers Maintainer: Tobias Dammers Stability: experimental License: MIT @@ -242,9 +242,9 @@ module Database.YeshQL ( -- * Quasi-quoters that take strings - yesh, yesh1 + Yesh (..) -- * Quasi-quoters that take filenames -, yeshFile, yesh1File +, YeshFile (..) -- * Low-level generators in the 'Q' monad , mkQueryDecs , mkQueryExp @@ -283,18 +283,17 @@ | otherwise = let (j, k) = divMod i 26 in nthIdent j ++ nthIdent k +-- | This typeclass is needed to allow 'yesh' and 'yesh1' to be used +-- interchangeably as quasi-quoters and TH functions. Because the intended +-- instances are @String -> Q [Dec]@ and @QuasiQuoter@, it is unfortunately not +-- possible to give the methods more obvious signatures like @String -> a@. class Yesh a where - -- | Generate a top-level declaration or an expression for a single SQL query. - -- If used at the top level (i.e., generating a declaration), the query - -- definition must specify a query name. - yesh1 :: a - - -- | Generate top-level declarations or expressions for several SQL queries. - -- If used at the top level (i.e., generating declarations), all queries in the - -- definitions must be named, and 'yesh' will generate a separate set of - -- functions for each. - -- If used in an expression context, the current behavior is somewhat - -- undesirable, namely sequencing the queries using '>>'. + -- | Generate top-level declarations or expressions for several SQL + -- queries. If used at the top level (i.e., generating declarations), all + -- queries in the definitions must be named, and 'yesh' will generate a + -- separate set of functions for each. If used in an expression context, + -- the current behavior is somewhat undesirable, namely sequencing the + -- queries using '>>'. -- -- Future versions will most likely change this to create a tuple of query -- expressions instead, such that you can write something like: @@ -316,34 +315,44 @@ -- DELETE FROM users WHERE id = :userID LIMIT 1; -- |] -- @ + yesh :: a + -- | Generate a top-level declaration or an expression for a single SQL + -- query. If used at the top level (i.e., generating a declaration), the + -- query definition must specify a query name. + yesh1 :: a +-- | This typeclass is needed to allow 'yeshFile' and 'yesh1File' to be used +-- interchangeably as quasi-quoters and TH functions. +-- Because the intended instances are @FilePath -> Q [Dec]@ and @QuasiQuoter@, +-- it is unfortunately not possible to give the methods more obvious signatures +-- like @FilePath -> a@. class YeshFile a where - -- | Generate one query definition or expression from an external file. - -- In a declaration context, the query name will be derived from the filename - -- unless the query contains an explicit name. Query name derivation works as - -- follows: - -- - -- - Take only the basename (stripping off the directories and extension) - -- - Remove all non-alphabetic characters from the beginning of the name - -- - Remove all non-alphanumeric characters from the name - -- - Lower-case the first character. - -- - -- Note that since there is always a filename to derive the query name from, - -- explicitly defining a query name is only necessary when you want it to - -- differ from the filename; however, making it explicit anyway is probably a - -- good idea. - yesh1File :: a - - -- | Generate multiple query definitions or expressions from an external file. - -- Query name derivation works exactly like for 'yesh1File', except that an - -- underscore and a 0-based query index are appended to disambiguate queries - -- from the same file. + -- | Generate multiple query definitions or expressions from an external + -- file. Query name derivation works exactly like for 'yesh1File', except + -- that an underscore and a 0-based query index are appended to + -- disambiguate queries from the same file. -- -- In an expression context, the same caveats apply as for 'yesh', i.e., to -- generate expressions, you will almost certainly want 'yesh1File', not -- 'yeshFile'. yeshFile :: a + + -- | Generate one query definition or expression from an external file. In + -- a declaration context, the query name will be derived from the filename + -- unless the query contains an explicit name. Query name derivation works + -- as follows: + -- + -- 1. Take only the basename (stripping off the directories and extension) + -- 2. Remove all non-alphabetic characters from the beginning of the name + -- 3. Remove all non-alphanumeric characters from the name + -- 4. Lower-case the first character. + -- + -- Note that since there is always a filename to derive the query name + -- from, explicitly defining a query name is only necessary when you want + -- it to differ from the filename; however, making it explicit anyway is + -- probably a good idea. + yesh1File :: a instance Yesh (String -> Q [Dec]) where yesh1 = withParsedQuery mkQueryDecs diff --git a/src/Database/YeshQL/SqlRow/TH.hs b/src/Database/YeshQL/SqlRow/TH.hs --- a/src/Database/YeshQL/SqlRow/TH.hs +++ b/src/Database/YeshQL/SqlRow/TH.hs @@ -3,14 +3,16 @@ {-#LANGUAGE TemplateHaskell #-} {-#LANGUAGE QuasiQuotes #-} {-#LANGUAGE LambdaCase #-} +{-#LANGUAGE CPP #-} module Database.YeshQL.SqlRow.TH +( makeSqlRow +) where import Database.YeshQL.SqlRow.Class import Database.HDBC (fromSql, toSql) import Language.Haskell.TH import Language.Haskell.TH.Quote -import Data.Generics.SYB.WithClass.Derive (typeInfo) makeSqlRow :: Name -> Q [Dec] makeSqlRow entityName = do @@ -55,3 +57,73 @@ appE (varE (mkName "fromSql")) (varE (mkName $ "sql_" ++ nameBase fieldName)) + +{- + +Subsequent code taken from syb-with-class, under the following license: + +Copyright (c) 2004 - 2008 The University of Glasgow, CWI, + Simon Peyton Jones, Ralf Laemmel, + Ulf Norell, Sean Seefried, Simon D. Foster, + HAppS LLC + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +-} + +type Constructor = + (Name, -- Name of the constructor + Int, -- Number of constructor arguments + Maybe [Name], -- Name of the field selector, if any + [Type]) -- Type of the constructor argument + +typeInfo :: Dec + -> Q (Name, -- Name of the datatype + [Name], -- Names of the type parameters + [Constructor]) -- The constructors +typeInfo d + = case d of +#if MIN_VERSION_template_haskell(2,11,0) + DataD _ n ps _ cs _ -> return (n, map varName ps, map conA cs) + NewtypeD _ n ps _ c _ -> return (n, map varName ps, [conA c]) +#else + DataD _ n ps cs _ -> return (n, map varName ps, map conA cs) + NewtypeD _ n ps c _ -> return (n, map varName ps, [conA c]) +#endif + _ -> error ("derive: not a data type declaration: " ++ show d) + where + conA (NormalC c xs) = (c, length xs, Nothing, map snd xs) + conA (InfixC x1 c x2) = conA (NormalC c [x1, x2]) + conA (ForallC _ _ c) = conA c + conA (RecC c xs) = + let getField (n, _, _) = n + getType (_, _, t) = t + fields = map getField xs + types = map getType xs + in (c, length xs, Just fields, types) + varName (PlainTV n) = n + varName (KindedTV n _) = n diff --git a/yeshql.cabal b/yeshql.cabal --- a/yeshql.cabal +++ b/yeshql.cabal @@ -1,5 +1,5 @@ name: yeshql -version: 3.0.0.1 +version: 3.0.1.1 synopsis: YesQL-style SQL database abstraction description: Use quasi-quotations or TemplateHaskell to write SQL in SQL, while adding type annotations to turn SQL into well-typed Haskell @@ -25,7 +25,6 @@ , containers >= 0.5 && < 1.0 , filepath , parsec >= 3.0 && <4.0 - , syb-with-class >= 0.6.1.7 && <1 , template-haskell , convertible >= 1.1.1.0 && <2 hs-source-dirs: src