module Proteome.Data.Project where

import Ribosome (MsgpackDecode, MsgpackEncode)

import Proteome.Data.ProjectLang (ProjectLang (ProjectLang))
import Proteome.Data.ProjectMetadata (ProjectMetadata)
import Proteome.Data.ProjectType (ProjectType (ProjectType))

data Project =
  Project {
    Project -> ProjectMetadata
meta :: ProjectMetadata,
    Project -> [ProjectType]
types :: [ProjectType],
    Project -> Maybe ProjectLang
lang :: Maybe ProjectLang,
    Project -> [ProjectLang]
langs :: [ProjectLang]
  }
  deriving stock (Project -> Project -> Bool
(Project -> Project -> Bool)
-> (Project -> Project -> Bool) -> Eq Project
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Project -> Project -> Bool
$c/= :: Project -> Project -> Bool
== :: Project -> Project -> Bool
$c== :: Project -> Project -> Bool
Eq, Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Project] -> ShowS
$cshowList :: [Project] -> ShowS
show :: Project -> String
$cshow :: Project -> String
showsPrec :: Int -> Project -> ShowS
$cshowsPrec :: Int -> Project -> ShowS
Show, (forall x. Project -> Rep Project x)
-> (forall x. Rep Project x -> Project) -> Generic Project
forall x. Rep Project x -> Project
forall x. Project -> Rep Project x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Project x -> Project
$cfrom :: forall x. Project -> Rep Project x
Generic)
  deriving anyclass (Object -> Either DecodeError Project
(Object -> Either DecodeError Project) -> MsgpackDecode Project
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError Project
$cfromMsgpack :: Object -> Either DecodeError Project
MsgpackDecode, Project -> Object
(Project -> Object) -> MsgpackEncode Project
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: Project -> Object
$ctoMsgpack :: Project -> Object
MsgpackEncode)

instance Default Project where
  def :: Project
def =
    ProjectMetadata
-> [ProjectType] -> Maybe ProjectLang -> [ProjectLang] -> Project
Project ProjectMetadata
forall a. Default a => a
def [ProjectType]
forall a. Default a => a
def Maybe ProjectLang
forall a. Default a => a
def [ProjectLang]
forall a. Default a => a
def

langOrType :: Maybe ProjectLang -> Maybe ProjectType -> Maybe ProjectLang
langOrType :: Maybe ProjectLang -> Maybe ProjectType -> Maybe ProjectLang
langOrType (Just ProjectLang
lang') Maybe ProjectType
_ = ProjectLang -> Maybe ProjectLang
forall a. a -> Maybe a
Just ProjectLang
lang'
langOrType Maybe ProjectLang
Nothing (Just (ProjectType Text
tpe')) = ProjectLang -> Maybe ProjectLang
forall a. a -> Maybe a
Just (Text -> ProjectLang
ProjectLang Text
tpe')
langOrType Maybe ProjectLang
_ Maybe ProjectType
_ = Maybe ProjectLang
forall a. Maybe a
Nothing