{-# 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.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) => Opium.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 Opium.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]]