{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Database.PostgreSQL.Opium.FromField
  ( FromField (..)
  , fromField
  ) where

import Data.Attoparsec.Text
  ( Parser
  , anyChar
  , choice
  , decimal
  , double
  , parseOnly
  , signed
  , string
  , takeText
  )
import Data.Functor (($>))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Oid)
import GHC.Float (double2Float)

import qualified Data.Text as Text

import qualified Database.PostgreSQL.Opium.Oid as Oid

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

fromField :: FromField a => Text -> Either String a
fromField =
  parseOnly parseField

class FromField a where
  validOid :: Proxy a -> Oid -> Bool
  parseField :: Parser a

-- | See https://www.postgresql.org/docs/current/datatype-character.html.
instance FromField Text where
  validOid _ = Oid.text \/ Oid.character \/ Oid.characterVarying
  parseField = takeText

-- | See https://www.postgresql.org/docs/current/datatype-character.html.
instance FromField String where
  validOid _ = validOid @Text Proxy
  parseField = Text.unpack <$> parseField

-- | See https://www.postgresql.org/docs/current/datatype-character.html.
-- This instance accepts all character types but fails to decode fields that are not exactly one character.
instance FromField Char where
  validOid _ = validOid @Text Proxy
  parseField = anyChar

instance FromField Int where
  validOid _ = Oid.smallint \/ Oid.integer \/ Oid.bigint
  parseField = signed decimal

doubleParser :: Parser Double
doubleParser = choice
  [ string "NaN" $> nan
  , signed (string "Infinity" $> infinity)
  , double
  ]
  where
    nan = 0 / 0
    infinity = 1 / 0

instance FromField Float where
  validOid _ = Oid.real
  parseField = fmap double2Float doubleParser

instance FromField Double where
  validOid _ = Oid.real \/ Oid.doublePrecision
  parseField = doubleParser

boolParser :: Parser Bool
boolParser = choice
  [ string "t" $> True
  , string "f" $> False
  ]

-- | See https://www.postgresql.org/docs/current/datatype-boolean.html.
instance FromField Bool where
  validOid _ = Oid.boolean
  parseField = boolParser