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

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

import Data.ByteString (ByteString)
import Data.Time
  ( Day (..)
  , DiffTime
  , TimeOfDay (..)
  , UTCTime (..)
  , fromGregorian
  , secondsToDiffTime
  , timeOfDayToTime
  )
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 AUTCTime = AUTCTime
  { utctime :: UTCTime
  } deriving (Eq, Generic, Show)

instance FromRow AUTCTime 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_ query conn
  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)]

    it "Decodes smallint -42" $ \conn -> do
      shouldFetch conn "SELECT -42::SMALLINT AS int" [AnInt (-42)]

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

    it "Decodes bigint -42" $ \conn -> do
      shouldFetch conn "SELECT -42::BIGINT AS int" [AnInt (-42)]

  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)]

    it "Decodes -42" $ \conn -> do
      shouldFetch conn "SELECT -42 AS integer" [AnInteger (-42)]

  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)]

    it "Decodes negative one as 2^64-1" $ \conn -> do
      shouldFetch conn "SELECT -1::BIGINT AS word" [AWord maxBound]

    it "Decodes integer negative one as 2^32-1" $ \conn -> do
      shouldFetch conn "SELECT -1::INTEGER AS word" [AWord $ (2 :: Word) ^ (32 :: Word) - 1]

  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_ "SELECT 'NaN'::real AS float" conn
      value `shouldSatisfy` isNaN

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

    it "Decodes -Infinity::real" $ \conn -> do
      Right [AFloat value] <- Opium.fetch_ "SELECT '-Infinity'::real AS float" conn
      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_ "SELECT 'NaN'::double precision AS double" conn
      value `shouldSatisfy` isNaN

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

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

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

      Right [ADouble value1] <- Opium.fetch_ "SELECT '-inf'::double precision AS double" conn
      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]

      -- BC
      -- See https://www.postgresql.org/docs/current/datetime-input-rules.html:
      -- "If BC has been specified, negate the year and add one for internal storage. (There is no year zero in the Gregorian calendar, so numerically 1 BC becomes year zero.)"
      shouldFetch conn "SELECT date '0001-02-29 BC' AS day" [ADay $ fromGregorian 0 2 29]

  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 UTCTime" $ do
    it "Decodes timestamp with timezone" $ \conn -> do
      let ts0 = UTCTime (fromGregorian 2023 10 2) (timeOfDayToTime $ TimeOfDay 12 42 23)
      shouldFetch conn "SELECT timestamp with time zone '2023-10-02 12:42:23' AS utctime" [AUTCTime ts0]

      let ts1 = UTCTime (fromGregorian 294275 12 31) (timeOfDayToTime $ TimeOfDay 23 59 59)
      shouldFetch conn "SELECT timestamp with time zone '294275-12-31 23:59:59' AS utctime" [AUTCTime ts1]

      let ts2 = UTCTime (fromGregorian 1 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0)
      shouldFetch conn "SELECT timestamp with time zone '0001-01-01 00:00:00' AS utctime" [AUTCTime ts2]

      -- See note at the FromField Day instance.
      let ts3 = UTCTime (fromGregorian 0 2 29) (timeOfDayToTime $ TimeOfDay 0 0 0)
      shouldFetch conn "SELECT timestamp with time zone '0001-02-29 BC 00:00:00' AS utctime" [AUTCTime ts3]

  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]]