{-# LANGUAGE OverloadedStrings #-}

-- | This module provides orphan instances for the typeclasses
--   'PersistField' and 'PersistFieldSql'. The instances provided
--   are for the data types 'IPv4' and 'Mac' from the @ip@ package.
--   These instances will choose the
--   standard text type for the database column. If you are
--   using PostgreSQL, you may want to consider importing
--   the @Database.Persist.Net.PostgreSQL@ module instead.
module Database.Persist.Net.Simple
  () where

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

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

instance PersistField IPv4 where
  toPersistValue :: IPv4 -> PersistValue
toPersistValue = (IPv4 -> Text) -> IPv4 -> PersistValue
forall a. (a -> Text) -> a -> PersistValue
toPersistValueTextShow IPv4 -> Text
IPv4.encode
  fromPersistValue :: PersistValue -> Either Text IPv4
fromPersistValue = (Text -> Maybe IPv4) -> PersistValue -> Either Text IPv4
forall a. (Text -> Maybe a) -> PersistValue -> Either Text a
fromPersistValueTextRead Text -> Maybe IPv4
IPv4.decode

instance PersistFieldSql IPv4 where
  sqlType :: Proxy IPv4 -> SqlType
sqlType Proxy IPv4
_ = SqlType
SqlString

instance PersistField Mac where
  toPersistValue :: Mac -> PersistValue
toPersistValue = (Mac -> Text) -> Mac -> PersistValue
forall a. (a -> Text) -> a -> PersistValue
toPersistValueTextShow Mac -> Text
Mac.encode
  fromPersistValue :: PersistValue -> Either Text Mac
fromPersistValue = (Text -> Maybe Mac) -> PersistValue -> Either Text Mac
forall a. (Text -> Maybe a) -> PersistValue -> Either Text a
fromPersistValueTextRead Text -> Maybe Mac
Mac.decode

instance PersistFieldSql Mac where
  sqlType :: Proxy Mac -> SqlType
sqlType Proxy Mac
_ = SqlType
SqlString

fromPersistValueTextRead :: (Text -> Maybe a) -> PersistValue -> Either Text a
fromPersistValueTextRead :: forall a. (Text -> Maybe a) -> PersistValue -> Either Text a
fromPersistValueTextRead Text -> Maybe a
fromText PersistValue
z = do
  Text
t <- PersistValue -> Either Text Text
fromPersistValueText PersistValue
z
  case Text -> Maybe a
fromText Text
t of
    Maybe a
Nothing -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse the following text:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
t)
    Just a
v -> a -> Either Text a
forall a b. b -> Either a b
Right a
v

toPersistValueTextShow :: (a -> Text) -> a -> PersistValue
toPersistValueTextShow :: forall a. (a -> Text) -> a -> PersistValue
toPersistValueTextShow a -> Text
f a
a = Text -> PersistValue
PersistText (a -> Text
f a
a)