module Proteome.Data.ProjectConfig where

import Path (Abs, Dir, Path)
import Ribosome (MsgpackDecode, MsgpackEncode)

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

data ProjectConfig =
  ProjectConfig {
    ProjectConfig -> [Path Abs Dir]
baseDirs :: [Path Abs Dir],
    ProjectConfig -> Map ProjectType [Path Abs Dir]
typeDirs :: Map ProjectType [Path Abs Dir],
    ProjectConfig -> Map ProjectType [Path Abs Dir]
projectTypes :: Map ProjectType [Path Abs Dir],
    ProjectConfig -> Map ProjectType [ProjectType]
typeMap :: Map ProjectType [ProjectType],
    ProjectConfig -> Map ProjectType [Text]
typeMarkers :: Map ProjectType [Text],
    ProjectConfig -> Map ProjectType ProjectLang
langMap :: Map ProjectType ProjectLang,
    ProjectConfig -> Map ProjectLang [ProjectLang]
langsMap :: Map ProjectLang [ProjectLang]
  }
  deriving stock (ProjectConfig -> ProjectConfig -> Bool
(ProjectConfig -> ProjectConfig -> Bool)
-> (ProjectConfig -> ProjectConfig -> Bool) -> Eq ProjectConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectConfig -> ProjectConfig -> Bool
$c/= :: ProjectConfig -> ProjectConfig -> Bool
== :: ProjectConfig -> ProjectConfig -> Bool
$c== :: ProjectConfig -> ProjectConfig -> Bool
Eq, Int -> ProjectConfig -> ShowS
[ProjectConfig] -> ShowS
ProjectConfig -> String
(Int -> ProjectConfig -> ShowS)
-> (ProjectConfig -> String)
-> ([ProjectConfig] -> ShowS)
-> Show ProjectConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectConfig] -> ShowS
$cshowList :: [ProjectConfig] -> ShowS
show :: ProjectConfig -> String
$cshow :: ProjectConfig -> String
showsPrec :: Int -> ProjectConfig -> ShowS
$cshowsPrec :: Int -> ProjectConfig -> ShowS
Show, (forall x. ProjectConfig -> Rep ProjectConfig x)
-> (forall x. Rep ProjectConfig x -> ProjectConfig)
-> Generic ProjectConfig
forall x. Rep ProjectConfig x -> ProjectConfig
forall x. ProjectConfig -> Rep ProjectConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectConfig x -> ProjectConfig
$cfrom :: forall x. ProjectConfig -> Rep ProjectConfig x
Generic)
  deriving anyclass (Object -> Either DecodeError ProjectConfig
(Object -> Either DecodeError ProjectConfig)
-> MsgpackDecode ProjectConfig
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError ProjectConfig
$cfromMsgpack :: Object -> Either DecodeError ProjectConfig
MsgpackDecode, ProjectConfig -> Object
(ProjectConfig -> Object) -> MsgpackEncode ProjectConfig
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: ProjectConfig -> Object
$ctoMsgpack :: ProjectConfig -> Object
MsgpackEncode, ProjectConfig
ProjectConfig -> Default ProjectConfig
forall a. a -> Default a
def :: ProjectConfig
$cdef :: ProjectConfig
Default)