yeshql 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+184/−10 lines, 3 filesdep +filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath

API changes (from Hackage documentation)

Files

• src/Database/YeshQL.hs +166/−3
• src/Database/YeshQL/Parser.hs +14/−4
• yeshql.cabal +4/−3

@@ -120,12 +120,58 @@     -- ... generated implementation left out @ += Loading Queries From External Files++The 'yeshFile' and 'yesh1File' flavors take a file name instead of SQL+definition strings. Using these, you can put your SQL in external files rather+than clutter your code with long quasi-quotation blocks.++= Other Functions That YeshQL Generates++On top of the obvious query functions, a top-level YeshQL quasiquotation+introduces two more definitions per query: a 'String' variable prefixed+@describe-@, which contains the SQL query as passed to HDBC (similar to the+@DESCRIBE@ feature in some RDBMS systems), and another 'String' variable+prefixed @doc-@, which contains all the free-form comments that precede the SQL+query in the query definition.++So for example, this quasiquotation:++@+[yesh1|+    -- name:getUser :: (Integer, String)+    -- :userID :: Integer+    -- Gets one user by the "id" column.+    SELECT id, username FROM users WHERE id = :userID LIMIT 1 |]+@++...would produce the following three top-level definitions:++@+getUser :: IConnection conn => Integer -> conn -> [(Integer, String)]+getUser userID conn = ...++describeGetUser :: String+describeGetUser = \"SELECT id, username FROM users WHERE id = ? LIMIT 1\"++docGetUser :: String+docGetUser = \"Gets one user by the \\\"id\\\" column.\"+@+  -} module Database.YeshQL-( yesh, yesh1+(+-- * Quasi-quoters that take strings+  yesh, yesh1+-- * Quasi-quoters that take filenames+, yeshFile, yesh1File+-- * Low-level generators in the 'Q' monad , mkQueryDecs , mkQueryExp+-- * Query parsers , parseQuery+, parseQueries+-- * AST , ParsedQuery (..) ) where@@ -138,6 +184,8 @@ import qualified Text.Parsec as P import Data.Char (chr, ord, toUpper, toLower) import Control.Applicative ( (<$>), (<*>) )+import System.FilePath (takeBaseName)+import Data.Char (isAlpha, isAlphaNum)  import Database.YeshQL.Parser @@ -148,6 +196,8 @@                     in nthIdent j ++ nthIdent k  -- | 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 :: QuasiQuoter yesh1 = QuasiQuoter         { quoteDec = withParsedQuery mkQueryDecs@@ -157,6 +207,32 @@         }  -- | 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:+--+-- @+-- let (createUser, getUser, updateUser, deleteUser) = [yesh|+--      -- name:createUser :: (Integer)+--      -- :username :: String+--      INSERT INTO users (username) VALUES (:username) RETURNING id;+--      -- name:getUser :: (Integer, String)+--      -- :userID :: Integer+--      SELECT id, username FROM users WHERE id = :userID;+--      -- name:updateUser :: Integer+--      -- :userID :: Integer+--      -- :username :: String+--      UPDATE users SET username = :username WHERE id = :userID;+--      -- name:deleteUser :: Integer+--      -- :userID :: Integer+--      DELETE FROM users WHERE id = :userID LIMIT 1;+--  |]+-- @ yesh :: QuasiQuoter yesh = QuasiQuoter         { quoteDec = withParsedQueries mkQueryDecsMulti@@ -165,10 +241,53 @@         , quotePat = error "yesh does not generate patterns"         } +-- | 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 :: QuasiQuoter+yesh1File = QuasiQuoter+            { quoteDec = withParsedQueryFile mkQueryDecs+            , quoteExp = withParsedQueryFile mkQueryExp+            , quoteType = error "yesh1File does not generate types"+            , quotePat = error "yesh1File does not generate patterns"+            }++-- | 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 :: QuasiQuoter+yeshFile = QuasiQuoter+            { quoteDec = withParsedQueriesFile mkQueryDecsMulti+            , quoteExp = withParsedQueriesFile mkQueryExpMulti+            , quoteType = error "yeshFile does not generate types"+            , quotePat = error "yeshFile does not generate patterns"+            }+ queryName :: String -> String -> Name-queryName prefix basename =-    mkName $ prefix ++ ucfirst basename+queryName prefix = mkName . queryIdentifier prefix +queryIdentifier :: String -> String -> String+queryIdentifier "" basename =+    lcfirst . makeValidIdentifier . takeBaseName $ basename+queryIdentifier prefix basename =+    (prefix ++) . ucfirst . makeValidIdentifier . takeBaseName $ basename+ ucfirst :: String -> String ucfirst "" = "" ucfirst (x:xs) = toUpper x:xs@@ -183,6 +302,36 @@ withParsedQueries :: ([ParsedQuery] -> Q a) -> String -> Q a withParsedQueries = withParsed parseQueries +withParsedQueryFile :: (ParsedQuery -> Q a) -> FilePath -> Q a+withParsedQueryFile p fn =+    withParsedFile+        (parseQueryN fn)+        (p . nameQuery (queryIdentifier "" fn))+        fn++withParsedQueriesFile :: ([ParsedQuery] -> Q a) -> FilePath -> Q a+withParsedQueriesFile p fn =+    withParsedFile+        (parseQueriesN fn)+        (p . nameQueries (queryIdentifier "" fn))+        fn++nameQuery :: String -> ParsedQuery -> ParsedQuery+nameQuery qname pq+    | null (pqQueryName pq) = pq { pqQueryName = qname }+    | otherwise = pq++nameQueries :: String -> [ParsedQuery] -> [ParsedQuery]+nameQueries basename queries =+    zipWith nameQuery queryNames queries+    where+        queryNames = [ basename ++ "_" ++ show i | i <- [0..] ]++makeValidIdentifier :: String -> String+makeValidIdentifier =+    filter isAlphaNum .+    dropWhile (not . isAlpha)+ withParsed :: (Monad m, Show e) => (s -> Either e a) -> (a -> m b) -> s -> m b withParsed p a src = do     let parseResult = p src@@ -191,7 +340,20 @@                 Right x -> return x     a arg +class MonadPerformIO m where+    performIO :: IO a -> m a +instance MonadPerformIO IO where+    performIO = id++instance MonadPerformIO Q where+    performIO = runIO++withParsedFile :: (MonadPerformIO m, Monad m, Show e) => (String -> Either e a) -> (a -> m b) -> FilePath -> m b+withParsedFile p a filename =+    performIO (readFile filename) >>= withParsed p a++ pgQueryType :: ParsedQuery -> TypeQ pgQueryType query =     [t|IConnection conn =>@@ -216,6 +378,7 @@ mkQueryDecsMulti :: [ParsedQuery] -> Q [Dec] mkQueryDecsMulti queries = concat <$> mapM mkQueryDecs queries +-- TODO: instead of sequencing the queries, put them in a tuple. mkQueryExpMulti :: [ParsedQuery] -> Q Exp mkQueryExpMulti queries =     foldl1 (\a b -> VarE '(>>) `AppE` a `AppE` b) <$> mapM mkQueryExp queries

@@ -1,6 +1,8 @@ module Database.YeshQL.Parser ( parseQuery , parseQueries+, parseQueryN+, parseQueriesN , ParsedQuery (..) , ParsedType (..) , pqTypeFor@@ -87,11 +89,19 @@         extractItem (ParsedComment str) = Just str         extractItem _ = Nothing +parseQueryN :: String -> String -> Either ParseError ParsedQuery+parseQueryN fn src = +    runParser mainP () fn src+ parseQuery :: String -> Either ParseError ParsedQuery-parseQuery src = runParser mainP () "query" src+parseQuery = parseQueryN "" +parseQueriesN :: String -> String -> Either ParseError [ParsedQuery]+parseQueriesN fn src =+    runParser multiP () fn src+ parseQueries :: String -> Either ParseError [ParsedQuery]-parseQueries src = runParser multiP () "queries" src+parseQueries = parseQueriesN ""  mainP :: Parsec String () ParsedQuery mainP = do@@ -114,7 +124,7 @@ queryP :: Parsec String () ParsedQuery queryP = do     spaces-    (qn, retType) <- option ("query", Left (PlainType "Integer")) $ nameDeclP <|> namelessDeclP+    (qn, retType) <- option ("", Left (PlainType "Integer")) $ nameDeclP <|> namelessDeclP     extraItems <- many (paramDeclP <|> commentP)     items <- many (try commentP <|> try itemP)     return $ parsedQuery@@ -142,7 +152,7 @@     retType <- returnTypeP     whitespaceP     newlineP-    return ("query", retType)+    return ("", retType)  identifierP :: Parsec String () String identifierP =

@@ -1,5 +1,5 @@ name: yeshql-version: 0.1.0.0+version: 0.2.0.0 synopsis: YesQL-style SQL database abstraction description: license: MIT@@ -17,10 +17,11 @@     other-modules: Database.YeshQL.Parser     -- other-extensions:     build-depends: base >=4.6 && <5.0-                 , template-haskell                  , HDBC >= 2.4 && <3.0-                 , parsec >= 3.0 && <4.0                  , containers >= 0.5 && < 1.0+                 , filepath+                 , parsec >= 3.0 && <4.0+                 , template-haskell     hs-source-dirs: src     default-language: Haskell2010 test-suite tests