module Polysemy.Db.Data.DbHost where

newtype DbHost =
  DbHost { DbHost -> Text
unDbHost :: Text }
  deriving stock (DbHost -> DbHost -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbHost -> DbHost -> Bool
$c/= :: DbHost -> DbHost -> Bool
== :: DbHost -> DbHost -> Bool
$c== :: DbHost -> DbHost -> Bool
Eq, Int -> DbHost -> ShowS
[DbHost] -> ShowS
DbHost -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbHost] -> ShowS
$cshowList :: [DbHost] -> ShowS
show :: DbHost -> String
$cshow :: DbHost -> String
showsPrec :: Int -> DbHost -> ShowS
$cshowsPrec :: Int -> DbHost -> ShowS
Show, forall x. Rep DbHost x -> DbHost
forall x. DbHost -> Rep DbHost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DbHost x -> DbHost
$cfrom :: forall x. DbHost -> Rep DbHost x
Generic)
  deriving newtype (String -> DbHost
forall a. (String -> a) -> IsString a
fromString :: String -> DbHost
$cfromString :: String -> DbHost
IsString, Eq DbHost
DbHost -> DbHost -> Bool
DbHost -> DbHost -> Ordering
DbHost -> DbHost -> DbHost
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DbHost -> DbHost -> DbHost
$cmin :: DbHost -> DbHost -> DbHost
max :: DbHost -> DbHost -> DbHost
$cmax :: DbHost -> DbHost -> DbHost
>= :: DbHost -> DbHost -> Bool
$c>= :: DbHost -> DbHost -> Bool
> :: DbHost -> DbHost -> Bool
$c> :: DbHost -> DbHost -> Bool
<= :: DbHost -> DbHost -> Bool
$c<= :: DbHost -> DbHost -> Bool
< :: DbHost -> DbHost -> Bool
$c< :: DbHost -> DbHost -> Bool
compare :: DbHost -> DbHost -> Ordering
$ccompare :: DbHost -> DbHost -> Ordering
Ord)

instance Default DbHost where
  def :: DbHost
def = DbHost
"localhost"

json ''DbHost