yeshql 2.1.0.0 → 2.2.0.0
raw patch · 4 files changed
+93/−22 lines, 4 files
Files
- src/Database/YeshQL.hs +26/−1
- src/Database/YeshQL/Parser.hs +41/−18
- tests/Database/YeshQL/SimulationTests.hs +25/−2
- yeshql.cabal +1/−1
src/Database/YeshQL.hs view
@@ -136,6 +136,25 @@ -- ... generated implementation left out @ +On top of referencing parameters directly, you can also "drill down" with a+projection function, using @.@ syntax similar to property access in, say,+JavaScript. The intended use case is passing record types as arguments to+the query function, and then dereferencing them inside the query, like so:++@+ -- name:updateUser :: rowcount Int+ -- :user :: User+ UPDATE users+ SET username = :user.name+ WHERE id = :user.userID+@++Note that the part after the @.@ is a plain Haskell function that must be in+scope wherever the query is spliced.++Also note that projection functions can be chained, and are not limited to+record field accessors.+ == Loading Queries From External Files The 'yeshFile' and 'yesh1File' flavors take a file name instead of SQL@@ -544,5 +563,11 @@ else queryFunc `appE` (litE . stringL . pqQueryString $ query)- `appE` (listE [ appE (varE 'toSql) (varE . mkName $ n) | (n, t) <- (pqParamsRaw query) ])+ `appE` (listE (map paramArg $ pqParamsRaw query)) `appE` (varE . mkName $ "conn")++ where+ paramArg :: ExtractedParam -> ExpQ+ paramArg (ExtractedParam n ps _) = do+ let valE = foldl1 (flip appE) (map (varE . mkName) (n:ps))+ varE 'toSql `appE` valE
src/Database/YeshQL/Parser.hs view
@@ -6,6 +6,7 @@ , ParsedQuery (..) , ParsedType (..) , ParsedReturnType (..)+, ExtractedParam (..) , OneOrMany (..) , pqTypeFor )@@ -20,7 +21,9 @@ import Data.List (foldl', nub) import Data.Maybe (catMaybes, fromMaybe) -data ParsedType = PlainType String | MaybeType String | AutoType+data ParsedType = PlainType String+ | MaybeType String+ | AutoType deriving Show data OneOrMany = One | Many@@ -31,11 +34,19 @@ | ReturnRecord OneOrMany ParsedType deriving (Show) +data ExtractedParam =+ ExtractedParam+ { paramName :: String+ , paramProjections :: [String]+ , paramType :: ParsedType+ }+ deriving (Show)+ data ParsedQuery = ParsedQuery { pqQueryName :: String , pqQueryString :: String- , pqParamsRaw :: [(String, ParsedType)]+ , pqParamsRaw :: [ExtractedParam] , pqParamNames :: [String] , pqParamTypes :: Map String ParsedType , pqReturnType :: ParsedReturnType@@ -49,13 +60,19 @@ parsedQuery :: String -> String- -> [(String, ParsedType)]- -> [(String, ParsedType)]+ -> [ExtractedParam]+ -> [ExtractedParam] -> ParsedReturnType -> String -> Bool -> ParsedQuery-parsedQuery queryName queryString paramsRaw paramsExtra returnType docComment isDDL =+parsedQuery queryName+ queryString+ paramsRaw+ paramsExtra+ returnType+ docComment+ isDDL = ParsedQuery queryName queryString@@ -66,15 +83,15 @@ docComment isDDL -extractParamNames :: [(String, ParsedType)] -> [String]+extractParamNames :: [ExtractedParam] -> [String] extractParamNames xs =- nub . map fst $ xs+ nub . map paramName $ xs -extractParamTypeMap :: [(String, ParsedType)] -> Map String ParsedType+extractParamTypeMap :: [ExtractedParam] -> Map String ParsedType extractParamTypeMap = foldl' applyItem Map.empty where- applyItem :: Map String ParsedType -> (String, ParsedType) -> Map String ParsedType- applyItem m (n, t) =+ applyItem :: Map String ParsedType -> ExtractedParam -> Map String ParsedType+ applyItem m (ExtractedParam n _ t) = let tc = Map.lookup n m in case (tc, t) of (Nothing, AutoType) -> m@@ -86,6 +103,7 @@ data ParsedItem = ParsedLiteral String | ParsedParam String ParsedType+ | ParsedParamAttrib String [String] ParsedType | ParsedComment String | ParsedAnnotation Annotation deriving (Show)@@ -101,12 +119,14 @@ extractItem (ParsedLiteral str) = str extractItem (ParsedComment _) = "" extractItem (ParsedParam _ _) = "?"+ extractItem (ParsedParamAttrib _ _ _) = "?" -extractParsedParams :: [ParsedItem] -> [(String, ParsedType)]+extractParsedParams :: [ParsedItem] -> [ExtractedParam] extractParsedParams = catMaybes . map extractItem where- extractItem :: ParsedItem -> Maybe (String, ParsedType)- extractItem (ParsedParam n t) = Just (n, t)+ extractItem :: ParsedItem -> Maybe ExtractedParam+ extractItem (ParsedParam n t) = Just $ ExtractedParam n [] t+ extractItem (ParsedParamAttrib n p t) = Just $ ExtractedParam n p t extractItem _ = Nothing extractDocComment :: [ParsedItem] -> String@@ -266,13 +286,13 @@ whitespaceP t <- option AutoType $ do string "::"- whitespaceP- t <- typeP- whitespaceP- return t+ whitespaceP *> typeP <* whitespaceP newlineP return $ ParsedParam name t +projectionP :: Parsec String () String+projectionP = char '.' *> identifierP+ commentP :: Parsec String () ParsedItem commentP = do try (whitespaceP >> string "--")@@ -283,10 +303,13 @@ paramP = do char ':' pname <- identifierP+ projections <- many projectionP ptype <- option AutoType $ do string "::" typeP- return $ ParsedParam pname ptype+ if null projections+ then return $ ParsedParam pname ptype+ else return $ ParsedParamAttrib pname projections ptype quotedP :: Parsec String () ParsedItem quotedP = do
tests/Database/YeshQL/SimulationTests.hs view
@@ -31,6 +31,8 @@ [ testSimpleSelect , testParametrizedSelect , testSingleInsert+ , testRecordReturn+ , testRecordParams , testUpdateReturnRowCount , testMultiQuery , testQueryFromFile@@ -81,9 +83,30 @@ actual <- [yesh| -- name:getUserByName :: User -- :username :: String- SELECT id, username FROM users- WHERE username = :username LIMIT 1|]+ SELECT id, username FROM users WHERE username = :username LIMIT 1|] "billy"+ conn+ let expected :: Maybe User+ expected = Just $ User 1 "billy"+ assertEqual "" expected actual+ where+ chatScript =+ [ ChatStep+ { chatQuery = sameThrough trim "SELECT id, username FROM users WHERE username = ? LIMIT 1"+ , chatParams = [exactly (toSql "billy")]+ , chatResultSet = [[toSql (1 :: Int), toSql "billy"]]+ , chatColumnNames = ["username"]+ , chatRowsAffected = 0+ }+ ]++testRecordParams :: TestTree+testRecordParams = testCase "Pass records as params" $ chatTest chatScript $ \conn -> do+ actual <- [yesh|+ -- name:getUserByName :: User+ -- :user :: User+ SELECT id, username FROM users WHERE username = :user.userName.reverse LIMIT 1|]+ (User 10 "yllib") conn let expected :: Maybe User expected = Just $ User 1 "billy"
yeshql.cabal view
@@ -1,5 +1,5 @@ name: yeshql-version: 2.1.0.0+version: 2.2.0.0 synopsis: YesQL-style SQL database abstraction description: Use quasi-quotations to write SQL in SQL, while at the same time adding type annotations to turn them into well-typed Haskell