yeshql 0.3.0.3 → 1.0.0.0
raw patch · 3 files changed
+93/−36 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Database.YeshQL: ParsedQuery :: String -> String -> [(String, ParsedType)] -> [String] -> Map String ParsedType -> Either ParsedType [ParsedType] -> String -> Bool -> ParsedQuery
+ Database.YeshQL: ParsedQuery :: String -> String -> [(String, ParsedType)] -> [String] -> Map String ParsedType -> ParsedReturnType -> String -> Bool -> ParsedQuery
- Database.YeshQL: [pqReturnType] :: ParsedQuery -> Either ParsedType [ParsedType]
+ Database.YeshQL: [pqReturnType] :: ParsedQuery -> ParsedReturnType
Files
- src/Database/YeshQL.hs +41/−20
- src/Database/YeshQL/Parser.hs +48/−14
- yeshql.cabal +4/−2
src/Database/YeshQL.hs view
@@ -38,7 +38,7 @@ ...will create a top-level function of type: @- insertUser :: IConnection conn => conn -> String -> IO [Integer]+ insertUser :: IConnection conn => conn -> String -> IO (Maybe Integer) @ == Syntax@@ -62,7 +62,7 @@ -- :id :: Integer SELECT id, name FROM users WHERE id = :id ;;;- -- name:getUserEx :: (Integer, String)+ -- name:getUserEx :: [(Integer, String)] -- :id :: Integer -- :filename :: String SELECT id, name FROM users WHERE name = :filename OR id = :id@@ -85,25 +85,35 @@ @ This line tells YeshQL to generate an object called @insertUser@, which should-be a function of type @IConnection conn => conn -> {...} -> IO (Integer)@+be a function of type @IConnection conn => conn -> {...} -> IO (Maybe Integer)@ (where the @{...}@ part depends on query parameters, see below). The declared return type can be one of the following: - (); the generated function will ignore any and all results from the query and always return ().-- An integer scalar, e.g. 'Integer' or 'Int'; the generated function will- return a row count from @INSERT@ / @UPDATE@ / ... statements, or 0 from- @SELECT@ statements.+- The keyword 'rowcount', followed by an integer scalar, e.g.+ 'Integer' or 'Int'; the generated function will return a row count from+ @INSERT@ / @UPDATE@ / ... statements, or 0 from @SELECT@ statements. - A tuple, where all elements implement 'FromSql'; the function will return- the result set from a @SELECT@ query as a list of tuples, or an empty list- for other query types.-- A "one-tuple", i.e., a type in parentheses. The return value will be a list+ the result set from a @SELECT@ query as a 'Maybe' of such tuples, or always+ 'Nothing' for other query types. For example, @:: (String, Int)@ produces+ a function whose type ends in @conn -> IO (Maybe (String, Int))@.+- A scalar, i.e., just a type name. The return value will be a 'Maybe' of scalars, containing the values from the first (or only) column in the result set. Note that, unlike Haskell, YeshQL does distinguish between @Type@ and @(Type)@: the former is a scalar type, while the latter is a- one-tuple whose only element is of type @Type@.+ one-tuple whose only element is of type @Type@. For example, @:: (Int)@+ produces a function whose type ends in @... -> conn -> IO (Maybe Int))@.+- A list of tuples, e.g. @[(String, Int)]@; the return value will be a list+ of such tuples.+- A list of scalars, e.g. @[Int]@. The return value will be a list of+ scalars, i.e., @... -> conn -> IO [Int]@. +Scalars can be written as "one-tuples", that is, @[Int]@ and @[(Int)]@ are+equivalent.++ @ -- :paramName :: Type @@@ -233,6 +243,10 @@ import Database.YeshQL.Parser +headMay :: [a] -> Maybe a+headMay [] = Nothing+headMay (x:_) = Just x+ nthIdent :: Int -> String nthIdent i | i < 26 = [chr (ord 'a' + i)]@@ -429,10 +443,13 @@ tupleT 0 else case pqReturnType query of- Left tn -> mkType tn- Right [] -> tupleT 0- Right (x:[]) -> appT listT $ mkType x- Right xs -> appT listT $ foldl' appT (tupleT $ length xs) (map mkType xs)+ ReturnRowCount tn -> mkType tn+ ReturnTuple One [] -> tupleT 0+ ReturnTuple One (x:[]) -> appT [t|Maybe|] $ mkType x+ ReturnTuple One xs -> appT [t|Maybe|] $ foldl' appT (tupleT $ length xs) (map mkType xs)+ ReturnTuple Many [] -> tupleT 0+ ReturnTuple Many (x:[]) -> appT listT $ mkType x+ ReturnTuple Many xs -> appT listT $ foldl' appT (tupleT $ length xs) (map mkType xs) mkType :: ParsedType -> Q Type mkType (MaybeType n) = [t|Maybe $(conT . mkName $ n)|]@@ -495,10 +512,10 @@ convert :: ExpQ convert = case pqReturnType query of- Left tn -> varE 'fromInteger- Right [] -> [|\_ -> ()|]- Right (x:[]) -> [|map (fromSql . head)|]- Right xs ->+ ReturnRowCount tn -> varE 'fromInteger+ ReturnTuple _ [] -> [|\_ -> ()|]+ ReturnTuple _ (x:[]) -> [|map (fromSql . head)|]+ ReturnTuple _ xs -> let varNames = map nthIdent [0..pred (length xs)] in [|map $(lamE -- \[a,b,c,...] ->@@ -506,8 +523,12 @@ -- (fromSql a, fromSql b, fromSql c, ...) (tupE $ (map (\n -> appE (varE 'fromSql) (varE . mkName $ n)) varNames)))|] queryFunc = case pqReturnType query of- Left _ -> [| \qstr params conn -> $convert <$> run conn qstr params |]- Right _ -> [| \qstr params conn -> $convert <$> quickQuery' conn qstr params |]+ ReturnRowCount _ ->+ [| \qstr params conn -> $convert <$> run conn qstr params |]+ ReturnTuple Many _ ->+ [| \qstr params conn -> $convert <$> quickQuery' conn qstr params |]+ ReturnTuple One _ ->+ [| \qstr params conn -> fmap headMay $ $convert <$> quickQuery' conn qstr params |] rawQueryFunc = [| \qstr conn -> runRaw conn qstr |] if pqDDL query then
src/Database/YeshQL/Parser.hs view
@@ -5,6 +5,8 @@ , parseQueriesN , ParsedQuery (..) , ParsedType (..)+, ParsedReturnType (..)+, OneOrMany (..) , pqTypeFor ) where@@ -21,6 +23,13 @@ data ParsedType = PlainType String | MaybeType String | AutoType deriving Show +data OneOrMany = One | Many+ deriving (Show, Eq, Enum, Ord)++data ParsedReturnType = ReturnRowCount ParsedType+ | ReturnTuple OneOrMany [ParsedType]+ deriving (Show)+ data ParsedQuery = ParsedQuery { pqQueryName :: String@@ -28,7 +37,7 @@ , pqParamsRaw :: [(String, ParsedType)] , pqParamNames :: [String] , pqParamTypes :: Map String ParsedType- , pqReturnType :: Either ParsedType [ParsedType]+ , pqReturnType :: ParsedReturnType , pqDocComment :: String , pqDDL :: Bool }@@ -41,7 +50,7 @@ -> String -> [(String, ParsedType)] -> [(String, ParsedType)]- -> Either ParsedType [ParsedType]+ -> ParsedReturnType -> String -> Bool -> ParsedQuery@@ -57,7 +66,7 @@ isDDL extractParamNames :: [(String, ParsedType)] -> [String]-extractParamNames xs = +extractParamNames xs = nub . map fst $ xs extractParamTypeMap :: [(String, ParsedType)] -> Map String ParsedType@@ -111,7 +120,7 @@ not . null $ [ undefined | ParsedAnnotation DDLAnnotation <- items ] parseQueryN :: String -> String -> Either ParseError ParsedQuery-parseQueryN fn src = +parseQueryN fn src = runParser mainP () fn src parseQuery :: String -> Either ParseError ParsedQuery@@ -145,7 +154,7 @@ queryP :: Parsec String () ParsedQuery queryP = do spaces- (qn, retType) <- option ("", Left (PlainType "Integer")) $ nameDeclP <|> namelessDeclP+ (qn, retType) <- option ("", ReturnRowCount (PlainType "Integer")) $ nameDeclP <|> namelessDeclP extraItems <- many (try annotationP <|> paramDeclP <|> commentP) items <- many (try itemP <|> try commentP) return $ parsedQuery@@ -157,18 +166,18 @@ (extractDocComment (extraItems ++ items)) (extractIsDDL (extraItems ++ items)) -nameDeclP :: Parsec String () (String, Either ParsedType [ParsedType])+nameDeclP :: Parsec String () (String, ParsedReturnType) nameDeclP = do try (whitespaceP >> string "--" >> whitespaceP >> string "name" >> whitespaceP >> char ':') whitespaceP qn <- identifierP whitespaceP- retType <- option (Left (PlainType "Integer")) (try (string "::" >> whitespaceP >> returnTypeP))+ retType <- option (ReturnRowCount (PlainType "Integer")) (try (string "::" >> whitespaceP >> returnTypeP)) whitespaceP newlineP return (qn, retType) -namelessDeclP :: Parsec String () (String, Either ParsedType [ParsedType])+namelessDeclP :: Parsec String () (String, ParsedReturnType) namelessDeclP = do try (whitespaceP >> string "--" >> whitespaceP >> string "::" >> whitespaceP) retType <- returnTypeP@@ -183,19 +192,39 @@ leadCharP = oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ "_" tailCharP = oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" -returnTypeP :: Parsec String () (Either ParsedType [ParsedType])-returnTypeP = returnTypeMultiP <|> returnTypeSingleP+returnTypeP :: Parsec String () ParsedReturnType+returnTypeP = returnTypeRowcountP <|> returnTypeMultiP <|> returnTypeSingleP -returnTypeSingleP :: Parsec String () (Either ParsedType [ParsedType])-returnTypeSingleP = Left <$> typeP+returnTypeRowcountP :: Parsec String () ParsedReturnType+returnTypeRowcountP = do+ try (string "rowcount")+ whitespaceP+ ReturnRowCount <$> typeP -returnTypeMultiP :: Parsec String () (Either ParsedType [ParsedType])+returnTypeMultiP :: Parsec String () ParsedReturnType returnTypeMultiP =- Right <$> between+ ReturnTuple Many <$> between+ (char '[' >> whitespaceP)+ (char ']' >> whitespaceP)+ returnTypeRowP++returnTypeSingleP :: Parsec String () ParsedReturnType+returnTypeSingleP =+ ReturnTuple One <$> returnTypeRowP++returnTypeRowP :: Parsec String () [ParsedType]+returnTypeRowP =+ returnTypeTupleP <|> + fmap (:[]) typeP++returnTypeTupleP :: Parsec String () [ParsedType]+returnTypeTupleP =+ between (char '(' >> whitespaceP) (char ')' >> whitespaceP) (sepBy (between whitespaceP whitespaceP typeP) (char ',')) + typeP :: Parsec String () ParsedType typeP = do name <- identifierP@@ -266,6 +295,11 @@ whitespaceP :: Parsec String () () whitespaceP = do many (oneOf " \t\r")+ return ()++whitespace1P :: Parsec String () ()+whitespace1P = do+ many1 (oneOf " \t\r") return () ignore :: Parsec s u a -> Parsec s u ()
yeshql.cabal view
@@ -1,7 +1,9 @@ name: yeshql-version: 0.3.0.3+version: 1.0.0.0 synopsis: YesQL-style SQL database abstraction-description:+description: Use quasi-quotations to write SQL in SQL, while at the same time+ adding type annotations to turn them into well-typed Haskell+ functions. license: MIT license-file: LICENSE author: Tobias Dammers