mysql-simple-quasi 1.0.0.1 → 1.0.0.2

raw patch · 2 files changed

+5/−105 lines, 2 filesdep −Cabaldep −sybdep ~base

Dependencies removed: Cabal, syb

Dependency ranges changed: base

Files

• Database/MySQL/Simple/Quasi/Test.hs +0/−100
• mysql-simple-quasi.cabal +5/−5

@@ -1,100 +0,0 @@-{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}---module Database.MySQL.Simple.QQ.Test where--import Control.Applicative ((<$>))-import System.Exit (ExitCode(..), exitWith)--import Data.Generics (everywhere, mkT)-import Data.Generics.Text (gshow)-import Data.List (isPrefixOf)--import Database.MySQL.Simple.Quasi--import Language.Haskell.TH (runQ)-import Language.Haskell.TH.Ppr (pprint)-import Language.Haskell.TH.Quote (quoteExp)-import qualified Language.Haskell.TH.Syntax as TH-import Language.Haskell.Meta.Parse (parseExp)--qual :: [(String, String)] -> String -> String-qual prefixTgts = go prefixTgts-  where-    go _ [] = []-    go ((prefix, tgt):more) src-      | tgt `isPrefixOf` src = prefix ++ tgt ++ go prefixTgts (drop (length tgt) src)-      | otherwise = go more src-    go [] (c:cs) = c : go prefixTgts cs---collapseForall :: TH.Exp -> TH.Exp-collapseForall (TH.SigE e t) = TH.SigE e $ collapseForallT t-  where-    collapseForallT (TH.ForallT ts [] (TH.ForallT [] ctxt inner)) = TH.ForallT ts ctxt inner-    collapseForallT x = x-collapseForall e = e---- | Code from qquery uses NameG but haskell-src-meta uses NameQ.--- This hack turns all NameG into NameQ ready for comparison:-canonName :: TH.Name -> TH.Name-canonName = TH.mkName . show --unqualName :: TH.Name -> TH.Name-unqualName = TH.mkName . TH.nameBase--asCode :: TH.Exp -> String-asCode = pprint . everywhere (mkT unqualName)--dupeQueries :: String -> String-dupeQueries ('$':'\"':rest)-  = let (queryStr, '\"':more) = span (/= '\"') rest-    in "(\"" ++ queryStr ++ "\", Data.String.fromString \"" ++ queryStr ++ "\")" ++ dupeQueries more-dupeQueries (c:cs) = c : dupeQueries cs-dupeQueries [] = []--(==>) :: String -> String -> IO Bool-(==>) src expS = do-  act <- everywhere (mkT canonName) <$> runQ (quoteExp qquery src)-  let expS' = qual [("Database.MySQL.Simple.QQ.", "QQuery") -- Handles QQuery_ too-                   ,("Database.MySQL.Simple.QueryResults.", "QueryResults")-                   ,("Database.MySQL.Simple.Param.", "Param")-                   ,("Database.MySQL.Simple.Types.", "fromOnly") -- Try fromOnly before Only-                   ,("Database.MySQL.Simple.Types.", "Only")-                   ] . dupeQueries $ expS-  case collapseForall <$> parseExp expS' of-    Left e -> do putStrLn $ "Problem parsing expected output: " ++ e-                 return False-    Right x | x == act -> return True-            | otherwise -> do mapM_ putStrLn-                                [ "Mismatch. Expected:", "  " ++ asCode x, "  " ++ gshow x-                                , "Actual:", "  " ++ asCode act, "  " ++ gshow act]-                              return False--simple = "select * from users" ==> "QQuery_ GHC.Base.id $\"select * from users\" :: forall r. QueryResults r => QQuery_ r"--ret1 = "select id{Int} from users" ==> "QQuery_ fromOnly $\"select id from users\" :: QQuery_ Int" --ret2 = "select id{Int}, name{String} from users" ==> "QQuery_ GHC.Base.id $\"select id, name from users\" :: QQuery_ (Int, String)"--ret4 = "select id{Int}, f.*{String, Bool}, name{Double} from users, f" ==>-       "QQuery_ GHC.Base.id $\"select id, f.*, name from users, f\" :: QQuery_ (Int, String, Bool, Double)"--subst1 = "select * from users where name = ?{String}" ==>-         "QQuery Only GHC.Base.id $\"select * from users where name = ?\" :: forall r. QueryResults r => QQuery String r"--subst1b = "select * from users where name = ?" ==>-          "QQuery Only GHC.Base.id $\"select * from users where name = ?\" :: forall q r. (Param q, QueryResults r) => QQuery q r"--subst3 = "select id{Maybe Int} from users where name = ?{Int} and name2 = ?{Bool} and name3 = ?{Maybe Double}" ==>-          "QQuery GHC.Base.id fromOnly $\"select id from users where name = ? and name2 = ? and name3 = ?\" :: QQuery (Int, Bool, Maybe Double) (Maybe Int)"--subst3b = "select * from users where name = ? and name2 = ? and name3 = ?" ==>-          "QQuery GHC.Base.id GHC.Base.id $\"select * from users where name = ? and name2 = ? and name3 = ?\" :: forall q q1 q2 r. (Param q, Param q1, Param q2, QueryResults r) => QQuery (q, q1, q2) r"---escaped = "select \\{curled} from whatever where text = 'hello\\?'" ==>-          "QQuery_ GHC.Base.id $\"select {curled} from whatever where text = 'hello?'\" :: forall r. QueryResults r => QQuery_ r"--main :: IO ()-main = do passed <- and <$> sequence [simple, ret1, ret2, ret4, escaped, subst1, subst1b,-            subst3, subst3b]-          exitWith $ if passed then ExitSuccess else ExitFailure 1

@@ -1,5 +1,5 @@ name:                mysql-simple-quasi-version:             1.0.0.1+version:             1.0.0.2 synopsis:            Quasi-quoter for use with mysql-simple. description:         See the "Database.MySQL.Simple.Quasi" module documentation for more details. license:             BSD3@@ -18,7 +18,7 @@                        mysql-simple == 0.2.*,                        template-haskell -Test-Suite test-qq-    type:              exitcode-stdio-1.0-    main-is:           Database/MySQL/Simple/Quasi/Test.hs-    build-depends:     base, Cabal >= 1.18, haskell-src-meta, mysql-simple == 0.2.*, syb, template-haskell+--Test-Suite test-qq+--    type:              exitcode-stdio-1.0+--    main-is:           Database/MySQL/Simple/Quasi/Test.hs+--    build-depends:     base, Cabal >= 1.18, haskell-src-meta, mysql-simple == 0.2.*, syb, template-haskell