{-# language DataKinds #-}
{-# language DeriveAnyClass #-}
{-# language DerivingVia #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language StandaloneKindSignatures #-}

module Rel8.Type.Tag
  ( EitherTag( IsLeft, IsRight ), isLeft, isRight
  , MaybeTag( IsJust )
  , Tag( Tag )
  )
where

-- base
import Data.Bool ( bool )
import Data.Kind ( Type )
import Data.Semigroup ( Min( Min ) )
import Prelude

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Expr.Opaleye ( zipPrimExprsWith )
import Rel8.Expr.Serialize ( litExpr )
import Rel8.Type.Eq ( DBEq )
import Rel8.Type ( DBType, typeInformation )
import Rel8.Type.Information ( mapTypeInformation, parseTypeInformation )
import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
import Rel8.Type.Ord ( DBOrd )
import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )

-- text
import Data.Text ( Text )


type EitherTag :: Type
data EitherTag = IsLeft | IsRight
  deriving stock (EitherTag -> EitherTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EitherTag -> EitherTag -> Bool
$c/= :: EitherTag -> EitherTag -> Bool
== :: EitherTag -> EitherTag -> Bool
$c== :: EitherTag -> EitherTag -> Bool
Eq, Eq EitherTag
EitherTag -> EitherTag -> Bool
EitherTag -> EitherTag -> Ordering
EitherTag -> EitherTag -> EitherTag
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 :: EitherTag -> EitherTag -> EitherTag
$cmin :: EitherTag -> EitherTag -> EitherTag
max :: EitherTag -> EitherTag -> EitherTag
$cmax :: EitherTag -> EitherTag -> EitherTag
>= :: EitherTag -> EitherTag -> Bool
$c>= :: EitherTag -> EitherTag -> Bool
> :: EitherTag -> EitherTag -> Bool
$c> :: EitherTag -> EitherTag -> Bool
<= :: EitherTag -> EitherTag -> Bool
$c<= :: EitherTag -> EitherTag -> Bool
< :: EitherTag -> EitherTag -> Bool
$c< :: EitherTag -> EitherTag -> Bool
compare :: EitherTag -> EitherTag -> Ordering
$ccompare :: EitherTag -> EitherTag -> Ordering
Ord, ReadPrec [EitherTag]
ReadPrec EitherTag
Int -> ReadS EitherTag
ReadS [EitherTag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EitherTag]
$creadListPrec :: ReadPrec [EitherTag]
readPrec :: ReadPrec EitherTag
$creadPrec :: ReadPrec EitherTag
readList :: ReadS [EitherTag]
$creadList :: ReadS [EitherTag]
readsPrec :: Int -> ReadS EitherTag
$creadsPrec :: Int -> ReadS EitherTag
Read, Int -> EitherTag -> ShowS
[EitherTag] -> ShowS
EitherTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EitherTag] -> ShowS
$cshowList :: [EitherTag] -> ShowS
show :: EitherTag -> String
$cshow :: EitherTag -> String
showsPrec :: Int -> EitherTag -> ShowS
$cshowsPrec :: Int -> EitherTag -> ShowS
Show, Int -> EitherTag
EitherTag -> Int
EitherTag -> [EitherTag]
EitherTag -> EitherTag
EitherTag -> EitherTag -> [EitherTag]
EitherTag -> EitherTag -> EitherTag -> [EitherTag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EitherTag -> EitherTag -> EitherTag -> [EitherTag]
$cenumFromThenTo :: EitherTag -> EitherTag -> EitherTag -> [EitherTag]
enumFromTo :: EitherTag -> EitherTag -> [EitherTag]
$cenumFromTo :: EitherTag -> EitherTag -> [EitherTag]
enumFromThen :: EitherTag -> EitherTag -> [EitherTag]
$cenumFromThen :: EitherTag -> EitherTag -> [EitherTag]
enumFrom :: EitherTag -> [EitherTag]
$cenumFrom :: EitherTag -> [EitherTag]
fromEnum :: EitherTag -> Int
$cfromEnum :: EitherTag -> Int
toEnum :: Int -> EitherTag
$ctoEnum :: Int -> EitherTag
pred :: EitherTag -> EitherTag
$cpred :: EitherTag -> EitherTag
succ :: EitherTag -> EitherTag
$csucc :: EitherTag -> EitherTag
Enum, EitherTag
forall a. a -> a -> Bounded a
maxBound :: EitherTag
$cmaxBound :: EitherTag
minBound :: EitherTag
$cminBound :: EitherTag
Bounded)
  deriving (NonEmpty EitherTag -> EitherTag
EitherTag -> EitherTag -> EitherTag
forall b. Integral b => b -> EitherTag -> EitherTag
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> EitherTag -> EitherTag
$cstimes :: forall b. Integral b => b -> EitherTag -> EitherTag
sconcat :: NonEmpty EitherTag -> EitherTag
$csconcat :: NonEmpty EitherTag -> EitherTag
<> :: EitherTag -> EitherTag -> EitherTag
$c<> :: EitherTag -> EitherTag -> EitherTag
Semigroup, Semigroup EitherTag
EitherTag
[EitherTag] -> EitherTag
EitherTag -> EitherTag -> EitherTag
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [EitherTag] -> EitherTag
$cmconcat :: [EitherTag] -> EitherTag
mappend :: EitherTag -> EitherTag -> EitherTag
$cmappend :: EitherTag -> EitherTag -> EitherTag
mempty :: EitherTag
$cmempty :: EitherTag
Monoid) via (Min EitherTag)
  deriving anyclass (DBType EitherTag
forall a. DBType a -> DBEq a
DBEq, DBEq EitherTag
forall a. DBEq a -> DBOrd a
DBOrd)


instance DBType EitherTag where
  typeInformation :: TypeInformation EitherTag
typeInformation = forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation Bool -> EitherTag
to EitherTag -> Bool
from forall a. DBType a => TypeInformation a
typeInformation
    where
      to :: Bool -> EitherTag
to = forall a. a -> a -> Bool -> a
bool EitherTag
IsLeft EitherTag
IsRight
      from :: EitherTag -> Bool
from EitherTag
IsLeft = Bool
False
      from EitherTag
IsRight = Bool
True


instance DBSemigroup EitherTag where
  <>. :: Expr EitherTag -> Expr EitherTag -> Expr EitherTag
(<>.) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
Opaleye.OpAnd)


instance DBMonoid EitherTag where
  memptyExpr :: Expr EitherTag
memptyExpr = forall a. Sql DBType a => a -> Expr a
litExpr forall a. Monoid a => a
mempty


isLeft :: Expr EitherTag -> Expr Bool
isLeft :: Expr EitherTag -> Expr Bool
isLeft = (forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsLeft forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==.)


isRight :: Expr EitherTag -> Expr Bool
isRight :: Expr EitherTag -> Expr Bool
isRight = (forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsRight forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==.)


type MaybeTag :: Type
data MaybeTag = IsJust
  deriving stock (MaybeTag -> MaybeTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaybeTag -> MaybeTag -> Bool
$c/= :: MaybeTag -> MaybeTag -> Bool
== :: MaybeTag -> MaybeTag -> Bool
$c== :: MaybeTag -> MaybeTag -> Bool
Eq, Eq MaybeTag
MaybeTag -> MaybeTag -> Bool
MaybeTag -> MaybeTag -> Ordering
MaybeTag -> MaybeTag -> MaybeTag
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 :: MaybeTag -> MaybeTag -> MaybeTag
$cmin :: MaybeTag -> MaybeTag -> MaybeTag
max :: MaybeTag -> MaybeTag -> MaybeTag
$cmax :: MaybeTag -> MaybeTag -> MaybeTag
>= :: MaybeTag -> MaybeTag -> Bool
$c>= :: MaybeTag -> MaybeTag -> Bool
> :: MaybeTag -> MaybeTag -> Bool
$c> :: MaybeTag -> MaybeTag -> Bool
<= :: MaybeTag -> MaybeTag -> Bool
$c<= :: MaybeTag -> MaybeTag -> Bool
< :: MaybeTag -> MaybeTag -> Bool
$c< :: MaybeTag -> MaybeTag -> Bool
compare :: MaybeTag -> MaybeTag -> Ordering
$ccompare :: MaybeTag -> MaybeTag -> Ordering
Ord, ReadPrec [MaybeTag]
ReadPrec MaybeTag
Int -> ReadS MaybeTag
ReadS [MaybeTag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MaybeTag]
$creadListPrec :: ReadPrec [MaybeTag]
readPrec :: ReadPrec MaybeTag
$creadPrec :: ReadPrec MaybeTag
readList :: ReadS [MaybeTag]
$creadList :: ReadS [MaybeTag]
readsPrec :: Int -> ReadS MaybeTag
$creadsPrec :: Int -> ReadS MaybeTag
Read, Int -> MaybeTag -> ShowS
[MaybeTag] -> ShowS
MaybeTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaybeTag] -> ShowS
$cshowList :: [MaybeTag] -> ShowS
show :: MaybeTag -> String
$cshow :: MaybeTag -> String
showsPrec :: Int -> MaybeTag -> ShowS
$cshowsPrec :: Int -> MaybeTag -> ShowS
Show, Int -> MaybeTag
MaybeTag -> Int
MaybeTag -> [MaybeTag]
MaybeTag -> MaybeTag
MaybeTag -> MaybeTag -> [MaybeTag]
MaybeTag -> MaybeTag -> MaybeTag -> [MaybeTag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MaybeTag -> MaybeTag -> MaybeTag -> [MaybeTag]
$cenumFromThenTo :: MaybeTag -> MaybeTag -> MaybeTag -> [MaybeTag]
enumFromTo :: MaybeTag -> MaybeTag -> [MaybeTag]
$cenumFromTo :: MaybeTag -> MaybeTag -> [MaybeTag]
enumFromThen :: MaybeTag -> MaybeTag -> [MaybeTag]
$cenumFromThen :: MaybeTag -> MaybeTag -> [MaybeTag]
enumFrom :: MaybeTag -> [MaybeTag]
$cenumFrom :: MaybeTag -> [MaybeTag]
fromEnum :: MaybeTag -> Int
$cfromEnum :: MaybeTag -> Int
toEnum :: Int -> MaybeTag
$ctoEnum :: Int -> MaybeTag
pred :: MaybeTag -> MaybeTag
$cpred :: MaybeTag -> MaybeTag
succ :: MaybeTag -> MaybeTag
$csucc :: MaybeTag -> MaybeTag
Enum, MaybeTag
forall a. a -> a -> Bounded a
maxBound :: MaybeTag
$cmaxBound :: MaybeTag
minBound :: MaybeTag
$cminBound :: MaybeTag
Bounded)
  deriving (NonEmpty MaybeTag -> MaybeTag
MaybeTag -> MaybeTag -> MaybeTag
forall b. Integral b => b -> MaybeTag -> MaybeTag
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> MaybeTag -> MaybeTag
$cstimes :: forall b. Integral b => b -> MaybeTag -> MaybeTag
sconcat :: NonEmpty MaybeTag -> MaybeTag
$csconcat :: NonEmpty MaybeTag -> MaybeTag
<> :: MaybeTag -> MaybeTag -> MaybeTag
$c<> :: MaybeTag -> MaybeTag -> MaybeTag
Semigroup, Semigroup MaybeTag
MaybeTag
[MaybeTag] -> MaybeTag
MaybeTag -> MaybeTag -> MaybeTag
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MaybeTag] -> MaybeTag
$cmconcat :: [MaybeTag] -> MaybeTag
mappend :: MaybeTag -> MaybeTag -> MaybeTag
$cmappend :: MaybeTag -> MaybeTag -> MaybeTag
mempty :: MaybeTag
$cmempty :: MaybeTag
Monoid) via (Min MaybeTag)
  deriving anyclass (DBType MaybeTag
forall a. DBType a -> DBEq a
DBEq, DBEq MaybeTag
forall a. DBEq a -> DBOrd a
DBOrd)


instance DBType MaybeTag where
  typeInformation :: TypeInformation MaybeTag
typeInformation = forall a b.
(a -> Either String b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation Bool -> Either String MaybeTag
to forall {p}. p -> Bool
from forall a. DBType a => TypeInformation a
typeInformation
    where
      to :: Bool -> Either String MaybeTag
to Bool
False = forall a b. a -> Either a b
Left String
"MaybeTag can't be false"
      to Bool
True = forall a b. b -> Either a b
Right MaybeTag
IsJust
      from :: p -> Bool
from p
_ = Bool
True


instance DBSemigroup MaybeTag where
  <>. :: Expr MaybeTag -> Expr MaybeTag -> Expr MaybeTag
(<>.) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
Opaleye.OpAnd)


instance DBMonoid MaybeTag where
  memptyExpr :: Expr MaybeTag
memptyExpr = forall a. Sql DBType a => a -> Expr a
litExpr forall a. Monoid a => a
mempty


type Tag :: Type
newtype Tag = Tag Text
  deriving newtype
    ( Tag -> Tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
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 :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
Ord, ReadPrec [Tag]
ReadPrec Tag
Int -> ReadS Tag
ReadS [Tag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tag]
$creadListPrec :: ReadPrec [Tag]
readPrec :: ReadPrec Tag
$creadPrec :: ReadPrec Tag
readList :: ReadS [Tag]
$creadList :: ReadS [Tag]
readsPrec :: Int -> ReadS Tag
$creadsPrec :: Int -> ReadS Tag
Read, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show
    , NotNull Tag
TypeInformation Tag
forall a. NotNull a -> TypeInformation a -> DBType a
typeInformation :: TypeInformation Tag
$ctypeInformation :: TypeInformation Tag
DBType, DBType Tag
forall a. DBType a -> DBEq a
DBEq, DBEq Tag
forall a. DBEq a -> DBOrd a
DBOrd
    )