-- | This module provides orphan instances for data types
--   from the @ip@ package. These instances only work for
--   PostgresSQL. The following PostgreSQL column types are
--   used for each data types:
--
--   * 'IPv4': @inet@
--   * 'Mac': @macaddr@
--
module Database.Persist.Net.PostgreSQL
  () where

import Data.Monoid
import Data.Text (Text)
import Database.Persist
import Database.Persist.Class
import Database.Persist.Sql
import Net.IPv4.Unnormalized (unnormalizedDecodeRange)
import Net.Types (IPv4,IPv4Range,Mac)

import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import qualified Net.IPv4 as IPv4
import qualified Net.Mac as Mac

instance PersistField IPv4 where
  toPersistValue :: IPv4 -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> (IPv4 -> Text) -> IPv4 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Text
IPv4.encode
  fromPersistValue :: PersistValue -> Either Text IPv4
fromPersistValue PersistValue
v = case PersistValue
v of
    PersistDbSpecific ByteString
s -> case ByteString -> Maybe IPv4
IPv4.decodeUtf8 ByteString
s of
      Just IPv4
x -> IPv4 -> Either Text IPv4
forall a b. b -> Either a b
Right IPv4
x
      Maybe IPv4
Nothing -> Text -> Either Text IPv4
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue IPv4: Invalid format")
    PersistText Text
t -> case Text -> Maybe IPv4
IPv4.decode Text
t of
      Just IPv4
x -> IPv4 -> Either Text IPv4
forall a b. b -> Either a b
Right IPv4
x
      Maybe IPv4
Nothing -> Text -> Either Text IPv4
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue IPv4: Invalid format")
    PersistValue
y -> Text -> Either Text IPv4
forall a b. a -> Either a b
Left (Text -> Either Text IPv4) -> Text -> Either Text IPv4
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"PersistValue IPv4: Not a PersistDbSpecific: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
y)

-- | This does not normalize the range. Since PostgreSQL allows
-- the user to store nonnormalized ranges, this instance preserves
-- this behavior.
instance PersistField IPv4Range where
  toPersistValue :: IPv4Range -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (IPv4Range -> Text) -> IPv4Range -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4Range -> Text
IPv4.encodeRange
  fromPersistValue :: PersistValue -> Either Text IPv4Range
fromPersistValue PersistValue
v = case PersistValue
v of
    PersistDbSpecific ByteString
s -> case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
s of
      Right Text
t -> case Text -> Maybe IPv4Range
unnormalizedDecodeRange Text
t of
        Just IPv4Range
x -> IPv4Range -> Either Text IPv4Range
forall a b. b -> Either a b
Right IPv4Range
x
        Maybe IPv4Range
Nothing -> Text -> Either Text IPv4Range
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue IPv4Range: Invalid format")
      Left UnicodeException
_ -> Text -> Either Text IPv4Range
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue IPv4Range: Invalid format")
    PersistText Text
t -> case Text -> Maybe IPv4Range
unnormalizedDecodeRange Text
t of
      Just IPv4Range
x -> IPv4Range -> Either Text IPv4Range
forall a b. b -> Either a b
Right IPv4Range
x
      Maybe IPv4Range
Nothing -> Text -> Either Text IPv4Range
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue IPv4Range: Invalid format")
    PersistValue
y -> Text -> Either Text IPv4Range
forall a b. a -> Either a b
Left (Text -> Either Text IPv4Range) -> Text -> Either Text IPv4Range
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"PersistValue IPv4: Not a PersistDbSpecific: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
y)
  

instance PersistFieldSql IPv4 where
  sqlType :: Proxy IPv4 -> SqlType
sqlType Proxy IPv4
_ = Text -> SqlType
SqlOther (String -> Text
Text.pack String
"inet")

instance PersistFieldSql IPv4Range where
  sqlType :: Proxy IPv4Range -> SqlType
sqlType Proxy IPv4Range
_ = Text -> SqlType
SqlOther (String -> Text
Text.pack String
"inet")

instance PersistField Mac where
  toPersistValue :: Mac -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> (Mac -> Text) -> Mac -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mac -> Text
Mac.encode
  fromPersistValue :: PersistValue -> Either Text Mac
fromPersistValue PersistValue
v = case PersistValue
v of
    PersistDbSpecific ByteString
s -> case ByteString -> Maybe Mac
Mac.decodeUtf8 ByteString
s of
      Just Mac
x -> Mac -> Either Text Mac
forall a b. b -> Either a b
Right Mac
x
      Maybe Mac
Nothing -> Text -> Either Text Mac
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue MAC: Invalid format")
    PersistText Text
t -> case Text -> Maybe Mac
Mac.decode Text
t of
      Just Mac
x -> Mac -> Either Text Mac
forall a b. b -> Either a b
Right Mac
x
      Maybe Mac
Nothing -> Text -> Either Text Mac
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"PersistValue MAC: Invalid format")
    PersistValue
y -> Text -> Either Text Mac
forall a b. a -> Either a b
Left (Text -> Either Text Mac) -> Text -> Either Text Mac
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"PersistValue MAC: Not a PersistDbSpecific: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
y)

instance PersistFieldSql Mac where
  sqlType :: Proxy Mac -> SqlType
sqlType Proxy Mac
_ = Text -> SqlType
SqlOther (String -> Text
Text.pack String
"macaddr")