module ExceptionsSpec
  ( test,
    spec,
  )
where

import           Control.Exception
import           Database.GP.GenericPersistenceSafe
import           Database.HDBC
import           Database.HDBC.Sqlite3
import           GHC.Generics
import           Test.Hspec

-- `test` is here so that this module can be run from GHCi on its own.  It is
-- not needed for automatic spec discovery.
-- (start up stack repl --test to bring up ghci and have access to all the test functions)
test :: IO ()
test = hspec spec

prepareDB :: IO Conn
prepareDB = do
  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
  setupTable @Article conn defaultSqliteMapping
  return conn

data Article = Article
  { articleID :: Int,
    title     :: String,
    year      :: Int
  }
  deriving (Generic, Show, Eq)

instance Entity Article where
  autoIncrement = False
  idField = "articleID"

data Bogus = Bogus
  { bogusID    :: Int,
    bogusTitle :: String,
    bogusYear  :: Int
  }
  deriving (Generic, Show, Eq)

instance Entity Bogus where
  tableName = "Article"

  fieldsToColumns :: [(String, String)] -- ommitting the articles field,
  fieldsToColumns =
    -- as this can not be mapped to a single column
    [ ("bogusID", "articleID"),
      ("bogusTitle", "title"),
      ("bogusYear", "year")
    ]

  fromRow :: Conn -> [SqlValue] -> IO Bogus
  fromRow _conn _row = throw $ DatabaseError "can't create bogus"

yearField :: Field
yearField = field "year"

article :: Article
article = Article 1 "The Hitchhiker's Guide to the Galaxy" 1979

expectationSuccess :: IO ()
expectationSuccess = return ()

spec :: Spec
spec = do
  describe "Exception Handling" $ do
    it "detects duplicate inserts" $ do
      conn <- prepareDB
      _ <- insert conn article
      eitherExRes <- insert conn article :: IO (Either PersistenceException Article)
      case eitherExRes of
        Left di@(DuplicateInsert _msg) -> show di `shouldContain` "Entity already exists"
        _ -> expectationFailure "Expected DuplicateInsert exception"
    it "detects duplicate inserts in insertMany" $ do
      conn <- prepareDB
      _ <- insert conn article
      eitherExRes <- insertMany conn [article, article] :: IO (Either PersistenceException ())
      case eitherExRes of
        Left (DuplicateInsert msg) -> msg `shouldContain` "Entity already exists"
        _ -> expectationFailure "Expected DuplicateInsert exception"
    it "returns () for successful upsert" $ do
      conn <- prepareDB
      eitherExRes <- upsert conn article :: IO (Either PersistenceException ())
      case eitherExRes of
        Right () -> expectationSuccess
        _        -> expectationFailure "Expected ()"
    it "detects missing entities in selectById" $ do
      conn <- prepareDB
      eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)
      case eitherExRes of
        Left (EntityNotFound msg) -> msg `shouldContain` "not found"
        _ -> expectationFailure "Expected EntityNotFound exception"
    it "detects non unique entities in selectById" $ do
      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
      runRaw conn "CREATE TABLE article (articleID INTEGER, title TEXT, year INTEGER)"
      _ <- insert conn article
      _ <- insert conn article {title = "another title"}
      eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)
      case eitherExRes of
        Left (NoUniqueKey msg) -> msg `shouldContain` "More than one Article found for id SqlString \"1\""
        _ -> expectationFailure "Expected DuplicateEntity exception"

    it "detects bogus data in selectById" $ do
      conn <- prepareDB
      _ <- insert conn article
      eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Bogus)
      case eitherExRes of
        Left (DatabaseError msg) -> msg `shouldContain` "can't create bogus"
        Left pe -> expectationFailure $ "Expected DatabaseError exception, got " ++ show pe
        _ -> expectationFailure "Expected DatabaseError exception"

    it "detects missing entities in update" $ do
      conn <- prepareDB
      eitherExRes <- update conn article :: IO (Either PersistenceException ())
      case eitherExRes of
        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"
        _ -> expectationFailure "Expected EntityNotFound exception"
    it "detects missing entities in delete" $ do
      conn <- prepareDB
      eitherExRes <- delete conn article :: IO (Either PersistenceException ())
      case eitherExRes of
        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"
        _ -> expectationFailure "Right: Expected EntityNotFound exception"
    it "detects missing entities in deleteById" $ do
      conn <- prepareDB
      eitherExRes <- deleteById @Article conn "1" :: IO (Either PersistenceException ())
      case eitherExRes of
        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"
        _ -> expectationFailure "Expected EntityNotFound exception"
    it "detects general db issues in deleteById" $ do
      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
      eitherExRes <- deleteById @Article conn "1" :: IO (Either PersistenceException ())
      case eitherExRes of
        Left (DatabaseError msg) -> msg `shouldContain` "SqlError"
        _ -> expectationFailure "Expected DatabaseError exception"
    it "detects general backend issues" $ do
      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
      eitherExRes <- update conn article :: IO (Either PersistenceException ())
      case eitherExRes of
        Left (DatabaseError msg) -> msg `shouldContain` "SqlError"
        _ -> expectationFailure "Expected DatabaseError exception"
    it "has no leaking backend exceptions" $ do
      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
      _ <- update conn article :: IO (Either PersistenceException ())
      _ <- insert conn article :: IO (Either PersistenceException Article)
      _ <- upsert conn article :: IO (Either PersistenceException ())
      _ <- delete conn article :: IO (Either PersistenceException ())
      _ <- selectById conn "1" :: IO (Either PersistenceException Article)
      _ <- select conn allEntries :: IO (Either PersistenceException [Article])
      _ <- select conn (yearField =. "2023") :: IO (Either PersistenceException [Article])
      _ <- insertMany conn [article] :: IO (Either PersistenceException ())
      _ <- updateMany conn [article] :: IO (Either PersistenceException ())
      _ <- deleteMany conn [article] :: IO (Either PersistenceException ())
      expectationSuccess

    it "can find column names" $ do
      let columnName = columnNameFor @Article "articleID"
      columnName `shouldBe` "articleID"

    it "throws an exception when column name is not found" $ do
      let columnName = columnNameFor @Article "unknown"
      print columnName `shouldThrow` errorCall "columnNameFor: Article has no column mapping for unknown"

    it "reports unknown fields" $ do
      let index = fieldIndex @Article "unknown"
      print index `shouldThrow` errorCall "expectJust Field unknown is not present in type Article"

    it "handles duplicate insert exceptions" $ do
      handleDuplicateInsert (toException $ EntityNotFound "24") `shouldBe` DatabaseError "EntityNotFound \"24\""

    it "handles autoincrement edge cases" $ do
      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
      let article' = Article 200 "title" 2023
          expectedRow = [SqlInt64 200, SqlString "title", SqlInt64 2023]
      articleRow <- toRow conn article'
      articleRow `shouldBe` expectedRow
      -- Article is defined with autoIncrement = False
      removeAutoIncIdField @Article articleRow `shouldBe` expectedRow

      -- ArticleWithoutPK is defined with autoIncrement = True, but has no primary key field
      let articleWithoutPK = ArticleWithoutPK "title" 2023
          rowWithoutPK = [SqlString "title", SqlInt64 2023]
      articleRowWithoutPK <- toRow conn articleWithoutPK
      removeAutoIncIdField @ArticleWithoutPK articleRowWithoutPK `shouldBe` rowWithoutPK

      -- ArticleWithPKatEnd is defined with autoIncrement = True and has a primary key field as last column
      let articleWithPKatEnd = ArticleWithPKatEnd "title" 2023 200
          expectedRow2 = [SqlString "title", SqlInt64 2023]
      articleRowWithPKatEnd <- toRow conn articleWithPKatEnd
      removeAutoIncIdField @ArticleWithPKatEnd articleRowWithPKatEnd `shouldBe` expectedRow2

data ArticleWithoutPK = ArticleWithoutPK
  { title1 :: String,
    year1  :: Int
  }
  deriving (Generic, Show, Entity, Eq)

data ArticleWithPKatEnd = ArticleWithPKatEnd
  { title2     :: String,
    year2      :: Int,
    articleID2 :: Int
  }
  deriving (Generic, Show, Eq)

instance Entity ArticleWithPKatEnd where
  autoIncrement = True
  idField = "articleID2"