{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Database.PostgreSQL.Opium.FromFieldSpec (spec) where

import Data.ByteString (ByteString)
import Data.Time (Day (..), DiffTime, TimeOfDay (..), fromGregorian, secondsToDiffTime)
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
import Database.PostgreSQL.Opium (FromRow)
import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)

import qualified Data.ByteString as BS

import qualified Database.PostgreSQL.Opium as Opium

newtype AnInt = AnInt
  { int :: Int
  } deriving (Eq, Generic, Show)

instance FromRow AnInt where

newtype AnInteger = AnInteger
  { integer :: Integer
  } deriving (Eq, Generic, Show)

instance FromRow AnInteger where

newtype AWord = AWord
  { word :: Word
  } deriving (Eq, Generic, Show)

instance FromRow AWord where

newtype AByteString = AByteString
  { bytestring :: ByteString
  } deriving (Eq, Generic, Show)

instance FromRow AByteString where

newtype AText = AText
  { text :: Text
  } deriving (Eq, Generic, Show)

instance FromRow AText where

newtype AString = AString
  { string :: String
  } deriving (Eq, Generic, Show)

instance FromRow AString where

newtype AChar = AChar
  { char :: Char
  } deriving (Eq, Generic, Show)

instance FromRow AChar where

newtype AFloat = AFloat
  { float :: Float
  } deriving (Eq, Generic, Show)

instance FromRow AFloat

newtype ADouble = ADouble
  { double :: Double
  } deriving (Eq, Generic, Show)

instance FromRow ADouble where

newtype ABool = ABool
  { bool :: Bool
  } deriving (Eq, Generic, Show)

instance FromRow ABool where

newtype ADay = ADay
  { day :: Day
  } deriving (Eq, Generic, Show)

instance FromRow ADay where

newtype ADiffTime = ADiffTime
  { difftime :: DiffTime
  } deriving (Eq, Generic, Show)

instance FromRow ADiffTime where

newtype ATimeOfDay = ATimeOfDay
  { timeofday :: TimeOfDay
  } deriving (Eq, Generic, Show)

instance FromRow ATimeOfDay where

newtype ARawField = ARawField
  { raw :: Opium.RawField ByteString
  } deriving (Eq, Generic, Show)

instance FromRow ARawField where

shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> Text -> [a] -> IO ()
shouldFetch conn query expectedRows = do
  actualRows <- Opium.fetch_ conn query
  actualRows `shouldBe` Right expectedRows

(/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
p /\ q = \x -> p x && q x

spec :: SpecWith Connection
spec = do
  describe "FromField Int" $ do
    it "Decodes smallint" $ \conn -> do
      shouldFetch conn "SELECT 42::SMALLINT AS int" [AnInt 42]

    it "Decodes integer" $ \conn -> do
      shouldFetch conn "SELECT 42::INTEGER AS int" [AnInt 42]

    it "Decodes bigint" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 48)::BIGINT AS int" [AnInt $ (2 :: Int) ^ (48 :: Int)]

  describe "FromField Integer" $ do
    it "Decodes smallint" $ \conn -> do
      shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]

    it "Decodes integer" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 20)::INTEGER AS integer" [AnInteger $ (2 :: Integer) ^ (20 :: Integer)]

    it "Decodes bigint" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 48)::BIGINT AS integer" [AnInteger $ (2 :: Integer) ^ (48 :: Integer)]

  describe "FromField Word" $ do
    it "Decodes smallint" $ \conn -> do
      shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42]

    it "Decodes integer" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 20)::INTEGER AS word" [AWord $ (2 :: Word) ^ (20 :: Word)]

    it "Decodes bigint" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)]

  describe "FromField ByteString" $ do
    it "Decodes bytea" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"]

  describe "FromField Text" $ do
    it "Decodes text" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"]

    it "Decodes character" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS text" [AText "Hello, Wor"]
      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS text" [AText "Hello, World!       "]

    it "Decodes character varying" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS text" [AText "Hello, World!"]

  describe "FromField String" $ do
    it "Decodes text" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::TEXT AS string" [AString "Hello, World!"]

    it "Decodes character" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS string" [AString "Hello, Wor"]
      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS string" [AString "Hello, World!       "]

    it "Decodes character varying" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [AString "Hello, World!"]

  describe "FromField Char" $ do
    it "Decodes text" $ \conn -> do
      shouldFetch conn "SELECT 'X'::TEXT AS char" [AChar 'X']

    it "Decodes character" $ \conn -> do
      shouldFetch conn "SELECT 'XYZ'::CHARACTER(1) AS char" [AChar 'X']
      shouldFetch conn "SELECT ''::CHARACTER(1) AS char" [AChar ' ']

    it "Decodes character varying" $ \conn -> do
      shouldFetch conn "SELECT 'X'::CHARACTER VARYING (20) AS char" [AChar 'X']

  describe "FromField Float" $ do
    it "Decodes real" $ \conn -> do
      shouldFetch conn "SELECT 4.2::real AS float" [AFloat 4.2]

    it "Decodes NaN::real" $ \conn -> do
      Right [AFloat value] <- Opium.fetch_ conn "SELECT 'NaN'::real AS float"
      value `shouldSatisfy` isNaN

    it "Decodes Infinity::real" $ \conn -> do
      Right [AFloat value] <- Opium.fetch_ conn "SELECT 'Infinity'::real AS float"
      value `shouldSatisfy` (isInfinite /\ (> 0))

    it "Decodes -Infinity::real" $ \conn -> do
      Right [AFloat value] <- Opium.fetch_ conn "SELECT '-Infinity'::real AS float"
      value `shouldSatisfy` (isInfinite /\ (< 0))

  describe "FromField Double" $ do
    it "Decodes double precision" $ \conn -> do
      shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2]

    it "Decodes NaN::double precision" $ \conn -> do
      Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double"
      value `shouldSatisfy` isNaN

    it "Decodes Infinity::double precision" $ \conn -> do
      Right [ADouble value] <- Opium.fetch_ conn "SELECT 'Infinity'::double precision AS double"
      value `shouldSatisfy` (isInfinite /\ (> 0))

    it "Decodes -Infinity::double precision" $ \conn -> do
      Right [ADouble value] <- Opium.fetch_ conn "SELECT '-Infinity'::double precision AS double"
      value `shouldSatisfy` (isInfinite /\ (< 0))

    it "Decodes {inf,-inf}::double precision" $ \conn -> do
      Right [ADouble value0] <- Opium.fetch_ conn "SELECT 'inf'::double precision AS double"
      value0 `shouldSatisfy` (isInfinite /\ (> 0))

      Right [ADouble value1] <- Opium.fetch_ conn "SELECT '-inf'::double precision AS double"
      value1 `shouldSatisfy` (isInfinite /\ (< 0))

  describe "FromField Bool" $ do
    it "Decodes boolean" $ \conn -> do
      shouldFetch conn "SELECT true AS bool" [ABool True]
      shouldFetch conn "SELECT 't'::boolean AS bool" [ABool True]
      shouldFetch conn "SELECT 'yes'::boolean AS bool" [ABool True]
      shouldFetch conn "SELECT 'on'::boolean AS bool" [ABool True]
      shouldFetch conn "SELECT 1::boolean AS bool" [ABool True]
      shouldFetch conn "SELECT false AS bool" [ABool False]
      shouldFetch conn "SELECT 'f'::boolean AS bool" [ABool False]
      shouldFetch conn "SELECT 'no'::boolean AS bool" [ABool False]
      shouldFetch conn "SELECT 'off'::boolean AS bool" [ABool False]
      shouldFetch conn "SELECT 0::boolean AS bool" [ABool False]

  describe "FromField Day" $ do
    it "Decodes date" $ \conn -> do
      shouldFetch conn "SELECT date '1970-01-01' AS day" [ADay $ fromGregorian 1970 1 1]
      shouldFetch conn "SELECT date '2023-09-23' AS day" [ADay $ fromGregorian 2023 9 23]
      -- Example from postgres doc page
      shouldFetch conn "SELECT date 'J2451187' AS day" [ADay $ fromGregorian 1999 1 8]

  describe "FromField DiffTime" $ do
    it "Decodes the time" $ \conn -> do
      shouldFetch conn "SELECT time '00:00:00' AS difftime" [ADiffTime 0]
      shouldFetch conn "SELECT time '00:01:00' AS difftime" [ADiffTime $ secondsToDiffTime 60]
      shouldFetch conn "SELECT time '13:07:43' AS difftime" [ADiffTime $ secondsToDiffTime $ 13 * 3600 + 7 * 60 + 43]

  describe "FromField TimeOfDay" $ do
    it "Decodes the time" $ \conn -> do
      shouldFetch conn "SELECT time '00:00:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 0 0]
      shouldFetch conn "SELECT time '00:01:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 1 0]
      shouldFetch conn "SELECT time '13:07:43' AS timeofday" [ATimeOfDay $ TimeOfDay 13 7 43]

  describe "FromField RawField" $ do
    it "Simply returns the bytestring without decoding it" $ \conn -> do
      shouldFetch conn "SELECT 'Hello, World!'::bytea AS raw" [ARawField $ Opium.RawField "Hello, World!"]
      shouldFetch conn "SELECT 42::int AS raw" [ARawField $ Opium.RawField "\0\0\0\42"]
      shouldFetch conn "SELECT 42::bigint AS raw" [ARawField $ Opium.RawField "\0\0\0\0\0\0\0\42"]
      -- Opium assumes that the connection always uses UTF-8.
      -- The query string is encoded using UTF-8 before passing it to @libpq@.
      shouldFetch conn "SELECT 'Ära'::text AS raw" [ARawField $ Opium.RawField $ BS.pack [0xC3, 0x84, 0x72, 0x61]]