content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  -- |
  -- Module      : Database.Relational.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.Relational.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.Relational.HDBC.Persistable ()
  import Database.Relational (LiteralSQL (..))
  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 LiteralSQL Inet where
    showLiteral' (Inet na) = pure $ "INET" <> qstringNetAddr na
  
  instance LiteralSQL Cidr where
    showLiteral' (Cidr na) = pure $ "CIDR" <> qstringNetAddr na
  