diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs index 73f0a1ded..c967175e1 100644 --- a/persistent-mysql/Database/Persist/MySQL.hs +++ b/persistent-mysql/Database/Persist/MySQL.hs @@ -74,6 +74,7 @@ import qualified Data.Text.IO as T import GHC.Stack import System.Environment (getEnvironment) +import Database.Persist.MySQL.Internal import Database.Persist.Sql import Database.Persist.Sql.Types.Internal (makeIsolationLevelStatement) import qualified Database.Persist.Sql.Util as Util @@ -815,55 +816,6 @@ getColumn connectInfo getter tname [ PersistText cname getColumn _ _ _ x _ = return $ Left $ pack $ "Invalid result from INFORMATION_SCHEMA: " ++ show x --- | Extra column information from MySQL schema -data ColumnInfo = ColumnInfo - { ciColumnType :: Text - , ciMaxLength :: Maybe Integer - , ciNumericPrecision :: PersistValue - , ciNumericScale :: PersistValue - } - --- | Parse the type of column as returned by MySQL's --- @INFORMATION_SCHEMA@ tables. -parseColumnType :: Text -> ColumnInfo -> ExceptT String IO (SqlType, Maybe Integer) --- Ints --- The display width is deprecated and being removed in MySQL 8.X --- with [an exception of tinyint(1) which is used for boolean values](https://dev.mysql.com/doc/relnotes/mysql/8.0/en/news-8-0-19.html#mysqld-8-0-19-deprecation-removal). --- To be consistent with earlier versions, which do report it, accept either --- the bare type in `ciColumnType ci`, or the type adorned with the expected --- value for the display width (ie the defaults for int and bigint, or the --- value explicitly set in `showSqlType` for SqlBool). --- -parseColumnType "tinyint" ci - | ciColumnType ci == "tinyint(1)" = return (SqlBool, Nothing) - | otherwise = return (SqlOther "tinyint", Nothing) -parseColumnType "int" ci - | ciColumnType ci == "int" || ciColumnType ci == "int(11)" = return (SqlInt32, Nothing) -parseColumnType "bigint" ci - | ciColumnType ci == "bigint" || ciColumnType ci == "bigint(20)" = return (SqlInt64, Nothing) - --- Double -parseColumnType x@("double") ci | ciColumnType ci == x = return (SqlReal, Nothing) -parseColumnType "decimal" ci = - case (ciNumericPrecision ci, ciNumericScale ci) of - (PersistInt64 p, PersistInt64 s) -> - return (SqlNumeric (fromIntegral p) (fromIntegral s), Nothing) - _ -> - fail "missing DECIMAL precision in DB schema" --- Text -parseColumnType "varchar" ci = return (SqlString, ciMaxLength ci) -parseColumnType "text" _ = return (SqlString, Nothing) --- ByteString -parseColumnType "varbinary" ci = return (SqlBlob, ciMaxLength ci) -parseColumnType "blob" _ = return (SqlBlob, Nothing) --- Time-related -parseColumnType "time" _ = return (SqlTime, Nothing) -parseColumnType "datetime" _ = return (SqlDayTime, Nothing) -parseColumnType "date" _ = return (SqlDay, Nothing) - -parseColumnType _ ci = return (SqlOther (ciColumnType ci), Nothing) - - ---------------------------------------------------------------------- diff --git a/persistent-mysql/persistent-mysql.cabal b/persistent-mysql/persistent-mysql.cabal index 280f62965..ddf4babeb 100644 --- a/persistent-mysql/persistent-mysql.cabal +++ b/persistent-mysql/persistent-mysql.cabal @@ -42,7 +42,7 @@ library , text >= 1.2 , transformers >= 0.5 , unliftio-core - exposed-modules: Database.Persist.MySQL + exposed-modules: Database.Persist.MySQL, Database.Persist.MySQL.Internal ghc-options: -Wall default-language: Haskell2010 @@ -60,6 +60,7 @@ test-suite test CustomConstraintTest ImplicitUuidSpec JSONTest + TinyintTest ghc-options: -Wall build-depends: diff --git a/persistent-mysql/test/TinyintTest.hs b/persistent-mysql/test/TinyintTest.hs new file mode 100644 index 000000000..30296084c --- /dev/null +++ b/persistent-mysql/test/TinyintTest.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +module TinyintTest where + +import Control.Monad.Trans.Except +import Data.Text (Text) +import Database.Persist.MySQL +import Database.Persist.MySQL.Internal +import Test.Hspec + +testCase :: Text -> IO (Either String (SqlType, Maybe Integer)) +testCase t = runExceptT $ parseColumnType "tinyint" $ ColumnInfo + { ciColumnType = t + , ciMaxLength = Nothing + , ciNumericPrecision = PersistNull + , ciNumericScale = PersistNull + } + +specs :: Spec +specs = describe "parseColumnType/tinyint" $ do + it "parses tinyint as SqlOther \"tinyint\"" $ do + result <- testCase "tinyint" + result `shouldBe` Right (SqlOther "tinyint", Nothing) + it "parses tinyint(1) as SqlBool" $ do + result <- testCase "tinyint(1)" + result `shouldBe` Right (SqlBool, Nothing) + it "parses tinyint(4) as SqlOther \"tinyint\"" $ do + result <- testCase "tinyint(4)" + result `shouldBe` Right (SqlOther "tinyint", Nothing) + + diff --git a/persistent-mysql/test/main.hs b/persistent-mysql/test/main.hs index cd0a21804..eb7c749e9 100644 --- a/persistent-mysql/test/main.hs +++ b/persistent-mysql/test/main.hs @@ -61,6 +61,7 @@ import qualified JSONTest import qualified LongIdentifierTest import qualified RenameTest import qualified SumTypeTest +import qualified TinyintTest import qualified TransactionLevelTest import qualified UniqueTest import qualified UpsertTest @@ -221,6 +222,7 @@ main = do LongIdentifierTest.specsWith db GeneratedColumnTestSQL.specsWith db JSONTest.specs + TinyintTest.specs roundFn :: RealFrac a => a -> Integer roundFn = round