{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Database.HDBC.PostgreSQL.Instances
-- Copyright   : 2015-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines HDBC instances and SQL-literal instances for
-- PostgreSQL types
module Database.HDBC.PostgreSQL.Instances () where

import Control.Applicative ((<$>), pure, (<*))
import Data.String (IsString, fromString)
import Data.Monoid ((<>))
import Data.DList ()
import Data.ByteString.Char8 (unpack)
import Data.Convertible (Convertible (..), ConvertResult, ConvertError (..))
import Data.PostgreSQL.NetworkAddress (NetAddress, Inet (..), Cidr (..))
import Database.HDBC (SqlValue (..))
import Database.HDBC.Record.Persistable ()
import Database.Relational (ShowConstantTermsSQL (..))
import Database.PostgreSQL.Parser (evalParser)
import qualified Database.PostgreSQL.Parser as Parser
import Database.PostgreSQL.Printer (execPrinter)
import qualified Database.PostgreSQL.Printer as Printer


note :: a -> Maybe b -> Either a b
note e = maybe (Left e) Right

mapConvert :: Show a => String -> String -> a -> Either String b -> ConvertResult b
mapConvert srcT destT sv = either (Left . mke) Right  where
  mke em =
    ConvertError
    { convSourceValue   =  show sv
    , convSourceType    =  srcT
    , convDestType      =  destT
    , convErrorMessage  =  em
    }

takeAddressString :: SqlValue -> Maybe String
takeAddressString = d  where
  d (SqlString s)      =  Just s
  d (SqlByteString s)  =  Just $ unpack s
  d  _                 =  Nothing

toNetAddress :: SqlValue -> ConvertResult NetAddress
toNetAddress qv = mapConvert "SqlValue" "NetAddress" qv $ do
  s  <-  note "Fail to take address string from the column value."
         $ takeAddressString qv
  evalParser (Parser.netAddress <* Parser.eof) s

instance Convertible SqlValue Inet where
  safeConvert = (Inet <$>) . toNetAddress

instance Convertible SqlValue Cidr where
  safeConvert = (Cidr <$>) . toNetAddress

fromNetAddress :: NetAddress -> ConvertResult SqlValue
fromNetAddress = pure . SqlString . execPrinter Printer.netAddress

instance Convertible Inet SqlValue where
  safeConvert (Inet n) = fromNetAddress n

instance Convertible Cidr SqlValue where
  safeConvert (Cidr n) = fromNetAddress n

qstringNetAddr :: IsString s => NetAddress -> s
qstringNetAddr = fromString . ("'" ++) . (++ "'") . execPrinter Printer.netAddress

instance ShowConstantTermsSQL Inet where
  showConstantTermsSQL' (Inet na) = pure $ "INET" <> qstringNetAddr na

instance ShowConstantTermsSQL Cidr where
  showConstantTermsSQL' (Cidr na) = pure $ "CIDR" <> qstringNetAddr na