add TinyintTest that tests the special handling of tinyint(1)

yesodweb · Nov 30, 2023 · 385390b · 385390b
1 parent f123992
commit 385390b
Show file tree

Hide file tree

Showing 4 changed files with 35 additions and 50 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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