{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

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

import Data.Attoparsec.Text
  ( Parser
  , choice
  , decimal
  , double
  , parseOnly
  , signed
  , string
  , takeText
  )
import Data.Functor (($>))
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

data FieldError
  = FieldErrorUnexpectedNull
  | FieldErrorInvalidOid Oid
  | FieldErrorInvalidField Oid Text String
  deriving (Eq, Show)

mapLeft :: (b -> c) -> Either b a -> Either c a
mapLeft f (Left l) = Left $ f l
mapLeft _ (Right r) = Right r

fromParser
  :: (Oid -> Bool)
  -> Parser a
  -> Oid
  -> Text
  -> Either FieldError a
fromParser validOid parser oid field
    | validOid oid =
      mapLeft (FieldErrorInvalidField oid field) $ parseOnly parser field
    | otherwise =
      Left $ FieldErrorInvalidOid oid

class FromField a where
  fromField :: Oid -> Text -> Either FieldError a

instance FromField Text where
  fromField = fromParser
    (Oid.text \/ Oid.character \/ Oid.characterVarying)
    takeText

instance FromField String where
  fromField oid text = Text.unpack <$> fromField oid text

instance FromField Int where
  fromField = fromParser
    (Oid.smallint \/ Oid.integer \/ Oid.bigint)
    (signed decimal)

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

instance FromField Float where
  fromField = fromParser
    Oid.real
    (fmap double2Float floatParser)

instance FromField Double where
  fromField = fromParser
    (Oid.real \/ Oid.doublePrecision)
    floatParser