persistent-odbc 0.2.1.0 → 0.2.1.1
raw patch · 8 files changed
+122/−48 lines, 8 filesdep −monad-controldep ~persistentdep ~persistent-template
Dependencies removed: monad-control
Dependency ranges changed: persistent, persistent-template
Files
- examples/Test1.hs +2/−0
- examples/TestODBC.hs +60/−26
- persistent-odbc.cabal +8/−7
- src/Database/Persist/MigrateDB2.hs +15/−3
- src/Database/Persist/MigrateMSSQL.hs +15/−3
- src/Database/Persist/MigrateMySQL.hs +14/−3
- src/Database/Persist/MigratePostgres.hs +7/−1
- src/Database/Persist/ODBC.hs +1/−5
examples/Test1.hs view
@@ -12,6 +12,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} module Test1 where import qualified Database.Persist as P import Database.Persist.TH
examples/TestODBC.hs view
@@ -1,3 +1,10 @@+-- stack build --test --flag persistent-odbc:tester --stack-yaml=stack865.yaml +-- stack --stack-yaml=stack865.yaml exec -- testodbc s +-- stack build --test --flag persistent-odbc:tester --stack-yaml=stack8103.yaml +-- stack --stack-yaml=stack8103.yaml exec -- testodbc s +-- cabal configure -f tester +-- cabal build +-- cabal exec -- TestODBC s {-# OPTIONS -Wall #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} @@ -11,6 +18,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} module Main where import Database.Persist import Database.Persist.ODBC @@ -229,7 +238,9 @@ a1 <- insert $ Foo "test" liftIO $ putStrLn $ "a1=" ++ show a1 a2 <- selectList ([] :: [Filter Foo]) [] - liftIO $ putStrLn $ "a2=" ++ show a2 + liftIO $ putStrLn $ "a2=" + liftIO $ mapM_ print a2 + johnId <- insert $ Personz "John Doe" $ Just 35 liftIO $ putStrLn $ "johnId[" ++ show johnId ++ "]" janeId <- insert $ Personz "Jane Doe" Nothing @@ -237,14 +248,17 @@ a3 <- selectList ([] :: [Filter Personz]) [] unless (length a3 == 2) $ error $ "wrong number of Personz rows " ++ show a3 - liftIO $ putStrLn $ "a3=" ++ show a3 + liftIO $ putStrLn $ "a3=" + liftIO $ mapM_ print a3 + void $ insert $ BlogPost "My fr1st p0st" johnId liftIO $ putStrLn $ "after insert johnId" void $ insert $ BlogPost "One more for good measure" johnId liftIO $ putStrLn $ "after insert johnId 2" a4 <- selectList ([] :: [Filter BlogPost]) [] - liftIO $ putStrLn $ "a4=" ++ show a4 + liftIO $ putStrLn $ "a4=" + liftIO $ mapM_ print a4 unless (length a4 == 2) $ error $ "wrong number of BlogPost rows " ++ show a4 --oneJohnPost <- selectList [BlogPostAuthorId ==. johnId] [LimitTo 1] @@ -302,12 +316,12 @@ liftIO $ print p2 p3 <- selectList [PersonxName ==. "Michael"] [] - liftIO $ print p3 + liftIO $ mapM_ print p3 _ <- insert $ Personx "Michael2" 27 Nothing deleteWhere [PersonxName ==. "Michael2"] p4 <- selectList [PersonxAge <. 28] [] - liftIO $ print p4 + liftIO $ mapM_ print p4 update pid [PersonxAge =. 28] p5 <- get pid @@ -319,15 +333,15 @@ _ <- insert $ Personx "Eliezer" 2 $ Just "blue" p7 <- selectList [] [Asc PersonxAge] - liftIO $ print p7 + liftIO $ mapM_ print p7 _ <- insert $ Personx "Abe" 30 $ Just "black" p8 <- selectList [PersonxAge <. 30] [Desc PersonxName] - liftIO $ print p8 + liftIO $ mapM_ print p8 _ <- insert $ Personx "Abe1" 31 $ Just "brown" p9 <- selectList [PersonxName ==. "Abe1"] [] - liftIO $ print p9 + liftIO $ mapM_ print p9 a6 <- selectList ([] :: [Filter Personx]) [] unless (length a6 == 4) $ error $ "wrong number of Personx rows " ++ show a6 @@ -336,13 +350,13 @@ liftIO $ print p10 p11 <- selectList [PersonxColor ==. Just "blue"] [] - liftIO $ print p11 + liftIO $ mapM_ print p11 p12 <- selectList [PersonxColor ==. Nothing] [] - liftIO $ print p12 + liftIO $ mapM_ print p12 p13 <- selectList [PersonxColor !=. Nothing] [] - liftIO $ print p13 + liftIO $ mapM_ print p13 delete pid plast <- get pid @@ -362,7 +376,9 @@ a1 <- selectList ([] :: [Filter Persony]) [] unless (length a1 == 4) $ error $ "wrong number of Personz rows " ++ show a1 - liftIO $ putStrLn $ "persony " ++ show a1 + liftIO $ putStrLn $ "persony " + liftIO $ mapM_ print a1 + let sql = case dbtype of MSSQL {} -> "SELECT [name] FROM [persony] WHERE [name] LIKE '%Snoyman%'" MySQL {} -> "SELECT `name` FROM `persony` WHERE `name` LIKE '%Snoyman%'" @@ -390,7 +406,7 @@ a4 <- insert $ Test1 False Nothing 100.3 Nothing liftIO $ putStrLn $ "a4=" ++ show a4 ret <- selectList ([] :: [Filter Test1]) [] - liftIO $ putStrLn $ "ret=" ++ show ret + liftIO $ mapM_ print ret a5 <- selectList ([] :: [Filter Test1]) [] unless (length a5 == 4) $ error $ "wrong number of Test1 rows " ++ show a5 @@ -433,13 +449,17 @@ liftIO $ putStrLn $ "x31=" ++ show x31 a4 <- selectList ([] :: [Filter Asm]) [] - liftIO $ putStrLn $ "a4=" ++ show a4 + liftIO $ putStrLn "a4=" + liftIO $ mapM_ print a4 + unless (length a4 == 3) $ error $ "wrong number of Asm rows " ++ show a4 a5 <- selectList ([] :: [Filter Xsd]) [] - liftIO $ putStrLn $ "a5=" ++ show a5 + liftIO $ putStrLn "a5=" + liftIO $ mapM_ print a5 unless (length a5 == 3) $ error $ "wrong number of Xsd rows " ++ show a5 a6 <- selectList ([] :: [Filter Line]) [] - liftIO $ putStrLn $ "a6=" ++ show a6 + liftIO $ putStrLn "a6=" + liftIO $ mapM_ print a6 unless (length a6 == 9) $ error $ "wrong number of Line rows " ++ show a6 [Value mpos] <- select $ @@ -489,7 +509,8 @@ liftIO $ putStrLn $ "r1=" ++ show r1 liftIO $ putStrLn $ "r2=" ++ show r2 zs <- selectList [] [Desc TestrationalRat] - liftIO $ putStrLn $ "zs=" ++ show zs + liftIO $ putStrLn "zs=" + liftIO $ mapM_ print zs h1 <- insert $ Testhtml $ preEscapedToMarkup ("<p>hello</p>"::String) liftIO $ putStrLn $ "h1=" ++ show h1 @@ -503,12 +524,18 @@ test7 = do liftIO $ putStrLn "\n*** in test7\n" a1 <- selectList [] [Desc LinePos, LimitTo 2, OffsetBy 3] - liftIO $ putStrLn $ show (length a1) ++ " rows: limit=2,offset=3 a1=" ++ show a1 + liftIO $ putStrLn $ show (length a1) ++ " rows: limit=2,offset=3 a1=" + liftIO $ mapM_ print a1 + a2 <- selectList [] [Desc LinePos, LimitTo 2] - liftIO $ putStrLn $ show (length a2) ++ " rows: limit=2 a2=" ++ show a2 + liftIO $ putStrLn $ show (length a2) ++ " rows: limit=2 a2=" + liftIO $ mapM_ print a2 + a3 <- selectList [] [Desc LinePos, OffsetBy 3] - liftIO $ putStrLn $ show (length a3) ++ " rows: offset=3 a3=" ++ show a3 + liftIO $ putStrLn $ show (length a3) ++ " rows: offset=3 a3=" + liftIO $ mapM_ print a3 + test8 :: SqlPersistT (NoLoggingT (ResourceT IO)) () test8 = do liftIO $ putStrLn "\n*** in test8\n" @@ -525,10 +552,14 @@ test9 = do liftIO $ putStrLn "\n*** in test9\n" a1 <- selectList [] [Desc LinePos, LimitTo 2] - liftIO $ putStrLn $ show (length a1) ++ " rows: limit=2,offset=0 a1=" ++ show a1 + liftIO $ putStrLn $ show (length a1) ++ " rows: limit=2,offset=0 a1=" + liftIO $ mapM_ print a1 + a2 <- selectList [] [Desc LinePos, LimitTo 4] - liftIO $ putStrLn $ show (length a2) ++ " rows: limit=4,offset=0 a2=" ++ show a2 + liftIO $ putStrLn $ show (length a2) ++ " rows: limit=4,offset=0 a2=" + liftIO $ mapM_ print a2 + test10 :: DBType -> SqlPersistT (NoLoggingT (ResourceT IO)) () test10 dbtype = do liftIO $ putStrLn "\n*** in test10\n" @@ -544,13 +575,14 @@ -} _ -> void $ insert $ Testblob3 "" "hello3" "world3" ys <- selectList ([] :: [Filter Testblob3]) [] - liftIO $ putStrLn $ "ys=" ++ show ys + liftIO $ putStrLn "ys=" + liftIO $ mapM_ print ys a3 <- selectList ([] :: [Filter Testblob3]) [] case dbtype of Oracle {} -> unless (length a3 == 2) $ error $ show dbtype ++ " :wrong number of Testblob3 rows " ++ show a3 _ -> unless (length a3 == 3) $ error $ "wrong number of Testblob3 rows " ++ show a3 - liftIO $ print a3 + liftIO $ mapM_ print a3 test11 :: DBType -> SqlPersistT (NoLoggingT (ResourceT IO)) () test11 dbtype = do @@ -566,7 +598,8 @@ liftIO $ putStrLn "after testblob inserts" xs <- selectList ([] :: [Filter Testblob]) [] -- mssql fails if there is a null in a blog column - liftIO $ putStrLn $ "testblob xs=" ++ show xs + liftIO $ putStrLn $ "testblob xs=" + liftIO $ mapM_ print xs a1 <- selectList ([] :: [Filter Testblob]) [] case dbtype of @@ -586,7 +619,8 @@ -- Oracle {} -> unless (length a3 == 2) $ error $ show dbtype ++ " :wrong number of Testlen rows " ++ show a3 _ -> unless (length a3 == 2) $ error $ "wrong number of Testlen rows " ++ show a3 - liftIO $ putStrLn $ "a3=" ++ show a3 + liftIO $ putStrLn $ "a3=" + liftIO $ mapM_ print a3 limitoffset :: DBType -> Bool limitoffset dbtype = -- trace ("limitoffset dbtype=" ++ show dbtype) $
persistent-odbc.cabal view
@@ -1,12 +1,12 @@+cabal-version: 1.12 name: persistent-odbc -version: 0.2.1.0 +version: 0.2.1.1 synopsis: Backend for the persistent library using ODBC license: MIT license-file: LICENSE author: Grant Weyburne maintainer: gbwey9@gmail.com category: Database, Yesod -cabal-version: >= 1.8 build-type: Simple stability: Experimental homepage: https://github.com/gbwey/persistent-odbc @@ -37,6 +37,7 @@ ghc-options: -Wall hs-source-dirs: src + default-language: Haskell2010 build-depends: base >= 4.5 && < 5 , text @@ -50,8 +51,8 @@ , HDBC-odbc >= 2.6.0.0 , monad-logger , resourcet - , persistent-template >= 2.6.0 - , persistent >= 2.6.0 + , persistent-template >= 2.6.0 && < 2.8.3 + , persistent >= 2.6.0 && < 2.11 , bytestring @@ -78,15 +79,15 @@ , HDBC-odbc >= 2.6.0.0 , monad-logger , resourcet - , monad-control - , persistent-template >= 2.6.0 - , persistent >= 2.6.0 + , persistent-template >= 2.6.0 && < 2.8.3 + , persistent >= 2.6.0 && < 2.11 , bytestring else buildable: False Main-Is: TestODBC.hs Hs-Source-Dirs: examples Other-Modules: FtypeEnum, Employment,Test1 + default-language: Haskell2010 source-repository head type: git
src/Database/Persist/MigrateDB2.hs view
@@ -58,8 +58,13 @@ let name = entityDB val (idClmn, old) <- getColumns getter val let (newcols, udefs, fdefs) = mkColumns allDefs val - liftIO $ putStrLn $ "\n\nold="++show old - liftIO $ putStrLn $ "\n\nfdefs="++show fdefs + {- + liftIO $ do + putStrLn $ "\nold=" ++ show (length old) + mapM_ print old + putStrLn $ "\nfdefs=" ++ show (length fdefs) + mapM_ print fdefs + -} let udspair = map udToPair udefs case (idClmn, old, partitionEithers old) of @@ -226,7 +231,14 @@ ,"ORDER BY constraint_name, column_name"] us <- with (stmtQuery stmtCntrs (vals++vals)) (`connect` helperCntrs) - liftIO $ putStrLn $ "\n\ngetColumns cs="++show cs++"\n\nus="++show us + {- + liftIO $ do + putStrLn $ "\ngetColumns cs=" ++ show (length cs) + mapM_ print cs + putStrLn $ "\nus=" ++ show (length us) + mapM_ print us + -} + -- Return both return (ids, cs ++ us) where
src/Database/Persist/MigrateMSSQL.hs view
@@ -59,8 +59,13 @@ let name = entityDB val (idClmn, old) <- getColumns getter val let (newcols, udefs, fdefs) = mkColumns allDefs val - liftIO $ putStrLn $ "\n\nold="++show old - liftIO $ putStrLn $ "\n\nfdefs="++show fdefs + {- + liftIO $ do + putStrLn $ "\nold=" ++ show (length old) + mapM_ print old + putStrLn $ "\nfdefs=" ++ show (length fdefs) + mapM_ print fdefs + -} let udspair = map udToPair udefs case (idClmn, old, partitionEithers old) of @@ -208,7 +213,14 @@ ,"ORDER BY CONSTRAINT_NAME, " ,"COLUMN_NAME"] us <- with (stmtQuery stmtCntrs vals) (`connect` helperCntrs) - liftIO $ putStrLn $ "\n\ngetColumns cs="++show cs++"\n\nus="++show us + {- + liftIO $ do + putStrLn $ "\ngetColumns cs=" ++ show (length cs) + mapM_ print cs + putStrLn $ "\nus=" ++ show (length us) + mapM_ print us + -} + -- Return both return (ids, cs ++ us) where
src/Database/Persist/MigrateMySQL.hs view
@@ -60,8 +60,13 @@ let name = entityDB val (idClmn, old) <- getColumns getter val let (newcols, udefs, fdefs) = mkColumns allDefs val - liftIO $ putStrLn $ "\n\nold="++show old - liftIO $ putStrLn $ "\n\nfdefs="++show fdefs + {- + liftIO $ do + putStrLn $ "\nold=" ++ show (length old) + mapM_ print old + putStrLn $ "\nfdefs=" ++ show (length fdefs) + mapM_ print fdefs + -} let udspair = map udToPair udefs case (idClmn, old, partitionEithers old) of @@ -205,7 +210,13 @@ ,"ORDER BY CONSTRAINT_NAME, " ,"COLUMN_NAME"] us <- with (stmtQuery stmtCntrs vals) (`connect` helperCntrs) - liftIO $ putStrLn $ "\n\ngetColumns cs="++show cs++"\n\nus="++show us + {- + liftIO $ do + putStrLn $ "\ngetColumns cs=" ++ show (length cs) + mapM_ print cs + putStrLn $ "\nus=" ++ show (length us) + mapM_ print us + -} -- Return both return (ids, cs ++ us) where
src/Database/Persist/MigratePostgres.hs view
@@ -150,7 +150,13 @@ stmt' <- getter $ pack sqlc us <- with (stmtQuery stmt' vals) (`connect` helperU) - liftIO $ putStrLn $ "\n\ngetColumns cs="++show cs++"\n\nus="++show us + {- + liftIO $ do + putStrLn $ "\ngetColumns cs=" ++ show (length cs) + mapM_ print cs + putStrLn $ "\nus=" ++ show (length us) + mapM_ print us + -} return $ cs ++ us where getAll front = do
src/Database/Persist/ODBC.hs view
@@ -273,7 +273,7 @@ safeConvert (HSV.SqlInt32 i) = Right $ P $ PersistInt64 $ fromIntegral i safeConvert (HSV.SqlInt64 i) = Right $ P $ PersistInt64 i safeConvert (HSV.SqlInteger i) = Right $ P $ PersistInt64 $ fromIntegral i - safeConvert (HSV.SqlChar c) = Right $ P $ charChk c + safeConvert (HSV.SqlChar c) = Right $ P $ PersistInt64 . fromIntegral $ fromEnum c safeConvert (HSV.SqlBool b) = Right $ P $ PersistBool b safeConvert (HSV.SqlDouble d) = Right $ P $ PersistDouble d safeConvert (HSV.SqlRational r) = Right $ P $ PersistRational r @@ -289,7 +289,3 @@ safeConvert (HSV.SqlTimeDiff i) = Right $ P $ PersistInt64 $ fromIntegral i safeConvert (HSV.SqlNull) = Right $ P PersistNull -charChk :: Char -> PersistValue -charChk '\0' = PersistBool False -charChk '\1' = PersistBool True -charChk c = PersistText $ T.singleton c