module Proteome.Data.ProjectType where

import Ribosome (MsgpackDecode, MsgpackEncode)

newtype ProjectType =
  ProjectType { ProjectType -> Text
unProjectType :: Text }
  deriving stock (Eq ProjectType
Eq ProjectType
-> (ProjectType -> ProjectType -> Ordering)
-> (ProjectType -> ProjectType -> Bool)
-> (ProjectType -> ProjectType -> Bool)
-> (ProjectType -> ProjectType -> Bool)
-> (ProjectType -> ProjectType -> Bool)
-> (ProjectType -> ProjectType -> ProjectType)
-> (ProjectType -> ProjectType -> ProjectType)
-> Ord ProjectType
ProjectType -> ProjectType -> Bool
ProjectType -> ProjectType -> Ordering
ProjectType -> ProjectType -> ProjectType
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 :: ProjectType -> ProjectType -> ProjectType
$cmin :: ProjectType -> ProjectType -> ProjectType
max :: ProjectType -> ProjectType -> ProjectType
$cmax :: ProjectType -> ProjectType -> ProjectType
>= :: ProjectType -> ProjectType -> Bool
$c>= :: ProjectType -> ProjectType -> Bool
> :: ProjectType -> ProjectType -> Bool
$c> :: ProjectType -> ProjectType -> Bool
<= :: ProjectType -> ProjectType -> Bool
$c<= :: ProjectType -> ProjectType -> Bool
< :: ProjectType -> ProjectType -> Bool
$c< :: ProjectType -> ProjectType -> Bool
compare :: ProjectType -> ProjectType -> Ordering
$ccompare :: ProjectType -> ProjectType -> Ordering
Ord, ProjectType -> ProjectType -> Bool
(ProjectType -> ProjectType -> Bool)
-> (ProjectType -> ProjectType -> Bool) -> Eq ProjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectType -> ProjectType -> Bool
$c/= :: ProjectType -> ProjectType -> Bool
== :: ProjectType -> ProjectType -> Bool
$c== :: ProjectType -> ProjectType -> Bool
Eq, Int -> ProjectType -> ShowS
[ProjectType] -> ShowS
ProjectType -> String
(Int -> ProjectType -> ShowS)
-> (ProjectType -> String)
-> ([ProjectType] -> ShowS)
-> Show ProjectType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectType] -> ShowS
$cshowList :: [ProjectType] -> ShowS
show :: ProjectType -> String
$cshow :: ProjectType -> String
showsPrec :: Int -> ProjectType -> ShowS
$cshowsPrec :: Int -> ProjectType -> ShowS
Show, (forall x. ProjectType -> Rep ProjectType x)
-> (forall x. Rep ProjectType x -> ProjectType)
-> Generic ProjectType
forall x. Rep ProjectType x -> ProjectType
forall x. ProjectType -> Rep ProjectType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectType x -> ProjectType
$cfrom :: forall x. ProjectType -> Rep ProjectType x
Generic)
  deriving newtype (Object -> Either DecodeError ProjectType
(Object -> Either DecodeError ProjectType)
-> MsgpackDecode ProjectType
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError ProjectType
$cfromMsgpack :: Object -> Either DecodeError ProjectType
MsgpackDecode, ProjectType -> Object
(ProjectType -> Object) -> MsgpackEncode ProjectType
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: ProjectType -> Object
$ctoMsgpack :: ProjectType -> Object
MsgpackEncode, String -> ProjectType
(String -> ProjectType) -> IsString ProjectType
forall a. (String -> a) -> IsString a
fromString :: String -> ProjectType
$cfromString :: String -> ProjectType
IsString)